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.