Modifica una macro che funziona solo se l'intervallo inizia con una cella A1, T1 ecc


0

Ho una macro che funziona ma vorrei cambiare l'intervallo di celle da

Set SearchRange = Range("E1:E12") to  
Set SearchRange = Range("A21:A32")

Ho apportato la modifica al codice ma non funzionerà quando lo eseguo e non sono sicuro di quale sia il problema. Ho una spiegazione sotto il codice.

Sub Part()
    Dim SearchRange As Range, _
        DashPair    As Variant, _
        PairParts   As Variant, _
        SearchVal   As Variant, _
        FoundPos    As Variant, _
        NextCol     As Long

    Set SearchRange = Range("A21:A32")
    For Each DashPair In Range("B17, F17, J17")
        Err.Clear
        NextCol = 1
        If DashPair.Value <> "" Then
            PairParts = Split(DashPair, "-")
            If PairParts(1) = "15" Then
                SearchVal = DashPair.Offset(RowOffset:=1).Value

                On Error Resume Next
                 Set FoundPos = SearchRange.Find(SearchVal, LookAt:=xlWhole)
                If Not FoundPos Is Nothing Then
                    FoundPos = FoundPos.Row
                    ' find first empty column right of E
                    While SearchRange(FoundPos).Offset(ColumnOffset:=NextCol).Value <> ""
                        NextCol = NextCol + 1
                    Wend

                    PairParts(1) = PairParts(1) + 1
                    PairParts = Join(PairParts, "-")

                    With SearchRange(FoundPos).Offset(ColumnOffset:=NextCol)
                        .NumberFormat = "@"
                        .Value = "" & PairParts & ""
                    End With

                    DashPair.Resize(ColumnSize:=3).ClearContents
                End If
            End If  '15 found
        End If
    Next DashPair
End Sub

Esempio con risultato atteso.

  • Si prega di vedere il mio esempio di Excel, la macro cerca un 15 (come ultimo numero 20-15 ecc.) Solo nelle celle B17, F17 e J17 attualmente. Quando ha un risultato positivo, fa riferimento alla cella sottostante e utilizza quel numero per cercare le celle A21: A32 per una corrispondenza e posizionare la copia e incolla nella cella adiacente alla sua destra.

  • Esempio: la cella B30 ha un 20-15, usando la cella in basso, B18 ha un 1 in essa. 1 è il numero di ricerca nell'intervallo A21: A32. Una volta trovato in A21: l'intervallo A32 posiziona il 20-15 nella cella adiacente a destra (B21) e aumenta l'ultimo numero di 1 in modo che diventi 20-16.

  • Fa lo stesso con tutte le celle: B17, F17 e J17.

  • Dopo la scrittura elimina tutti i contenuti nella cella B17 / C17 / D17. Ci sono due esempi nel mio foglio Excel in cui deve accadere la stessa cosa.

foglio Excel

Risposte:


0

Il problema con il tuo codice è all'interno SearchRange(FoundPos). Funziona solo in questa applicazione se l' SearchRangeintervallo inizia dalla riga 1.

Modificando l'intervallo in A21:A32, la variabile FindPos sarà 21per il primo caso.
Ciò si traduce in SearchRange(FoundPos)restituzione della 21a riga del tuo intervallo, vale a dire A41.

Un sacco di modi per risolvere questo problema, ma di apportare modifiche minime nel codice, si potrebbe provare a sostituire SearchRange(FoundPos)con ActiveSheet.Cells(FoundPos, SearchRange.Column).


Ciao, ho cambiato il codice in While ActiveSheet.Cells (FoundPos, SearchRange.Column) .Offset (ColumnOffset: = NextCol) .Value <> "" e With ActiveSheet.Cells.Offset (ColumnOffset: = NextCol) sto ottenendo un errore 9 - indice fuori intervallo. Ci sto arrivando con VBA ma sicuramente potrei usare un po 'di aiuto se hai tempo.
— KAREN KENDALL,

Spero che tu intenda With ActiveSheet.Cells(FoundPos, SearchRange.Column).Offset(ColumnOffset:=NextCol), devi specificare la cella.
— Christofer Weber,

Un momento biondo, risolto il "Con" ma ora il messaggio è "Wend without While"
— KAREN KENDALL

Dovrebbe essere abbastanza chiaro dove è andato storto però. Non posso davvero aiutarti senza vedere quello che hai fatto.
— Christofer Weber,

Non sono sicuro di dove specificare la cella.
— KAREN KENDALL,
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.