Question

我需要一个VBA脚本，它将执行双FOR循环。第一个FOR循环是一个需要在多张纸上执行一些命令的循环（第一张纸是主纸，需要跳过！）

第二个for循环需要比较多行上的值。到目前为止，我已经粘贴了代码...


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

当前代码正在运行，但仅输出第一张（主表）的结果。它需要跳过第一张纸，然后遍历其余的纸。

Answer 1

更新摘要工作表

链接：StrComp Function

以下未经过测试。

代码

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

Answer 2

Dim irow As Long
Dim ws  As Worksheet
Dim mySheet As String
mySheet = "mainSheet" 'Insert in the mySheet variable the name of your main sheet
device = Cells(6, 1)
orow = 8
For Each ws In Application.ActiveWorkbook.Worksheets
    If ws.Name <> mySheet Then
        For irow = 2 To 10
            If ws.Range("A" & irow) = device Then
                orow = orow + 1
                Range("'SUMMARY'!a" & orow) = device
                Range("'SUMMARY'!b" & orow) = ws.Name
                '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
    End If
Next ws

带IF语句的VBA Double FOR循环

2 个答案:

更新摘要工作表