VBA Double FOR loop con una declaración IF

Oct 22 2020

Necesito un script VBA que realice un bucle FOR doble. El primer ciclo FOR, es un ciclo que necesita realizar algunos comandos en varias hojas (¡La primera hoja es la hoja principal y debe saltarse!)

El segundo bucle for necesita comparar valores en varias filas. He pegado mi código hasta ahora ...


Public Sub LoopOverSheets()
device = Cells(6, 1) 'This value is whatever the user chooses from a drop-down menu
Dim mySheet As Worksheet 'Creating variable for worksheet
orow = 8 'setting the starting output row

For Each mySheet In ThisWorkbook.Sheets 'this is the first FOR loop, to loop through ALL the worksheets
tabName = ActiveSheet.Name    'this is a variable that holds the name of the active sheet

    For irow = 2 To 10 'This line of code starts the SECOND FOR loop.
        If (Range("a" & irow)) = device Then 'This line of code compares values
            orow = orow + 1
            Range("'SUMMARY'!a" & orow) = device 'This line of code pastes the value of device variable
            Range("'SUMMARY'!b" & orow) = tabName 'This line of code needs to paste the name of the current active sheet
            'Range("'SUMMARY'!c" & orow) = Range("'tabName'!b" & irow) 'this line of code needs to paste whatever value is in the other sheet's cell
            'Range("'SUMMARY'!d" & orow) = Range("'tabName'!c" & irow) 'same objective as the last line of code, different rows and columns
        End If
    Next irow 'This line of code will iterate to the next orow. This is where I get an error (Compile Error : Next Without For)*******
Next mySheet 'This line of code will iterate to the next sheet

End Sub

Actualmente, el código se ejecuta, pero solo genera resultados de la primera (hoja principal). Necesita omitir la primera hoja e iterar por el resto.

Respuestas

VBasic2008 Oct 22 2020 at 19:10

Actualizar hoja de trabajo de resumen

Enlace: Función StrComp

  • Lo siguiente no está probado.

El código

Option Explicit

Sub loopOverSheets()
    
    Const tName As String = "Summary"
    Const tFirstRow  As Long = 8
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    Dim tgt As Worksheet
    Set tgt = wb.Worksheets(tName)
    Dim device As String
    device = tgt.Cells(6, 1).Value
    Dim tRow As Long
    tRow = tFirstRow
    
    Dim src As Worksheet
    Dim sName As String
    Dim i As Long
    For Each src In wb.Worksheets
        sName = src.Name
        If Not StrComp(sName, tName, vbTextCompare) = 0 Then
            For i = 2 To 10
                If StrComp(src.Range("A" & i), device, vbTextCompare) = 0 Then
                    tRow = tRow + 1
                    tgt.Range("A" & tRow).Value = device
                    tgt.Range("B" & tRow).Value = sName
                    tgt.Range("C" & tRow).Value = src.Range("B" & i).Value
                    tgt.Range("D" & tRow).Value = src.Range("C" & i).Value
                End If
            Next i
        End If
    Next src

    MsgBox "Data transferred.", vbInformation, "Success"
    
End Sub