Excel VBA：For循环扫描一组工作表

Posted 2023-02-25

【中文标题】Excel VBA：For循环扫描一组工作表

【英文标题】：Excel VBA: For loop to scan a set range of worksheets

【发布时间】：2013-08-09 17:52:59

【问题描述】：

我有一本工作簿，里面有 26 张纸。我只想从单元格“D15”开始扫描特定 17 个工作表中的 D 列。然而，这 15 张确实按增量顺序排列，即我想在第 4 和第 20 张之间扫描。

以下代码是我目前所拥有的，用户“餐饮主管”在上一个问题中让我开始使用它：Copy Paste macro is inducing 'grouped'-worksheet functionality?

Sub DSR_Autofill()

Variable Declarations:

Dim x_count As Long     'keeps track of how many "x"s you have
Dim i As Long           'for loop index
Dim n As Long           'while loop index

' Variable Initializations:

x_count = 0             'start x count at zero

' Clear Previous Data:

Sheets(2).Range("A25:A29").ClearContents        'Clears Summary Pages before scanning through
Sheets(3).Range("A18:A200").ClearContents

' Main Data Transfer Code:

For i = 5 To i = 20     'Starts at "Process Controls" and ends on "Product Stewardship"

    Sheets(i).Select    'Select current indexed worksheet and...
    Range("D15").Select '...the first item cell in the "Yes" Column

    n = 0               'initialize n to start at top item row every time

        Do While ActiveCell.Offset(n, -3) <> Empty      'Scan down "YES" column until Item Column (just A Column)...
                                                        '...has no characters in it (this includes space (" "))
            Call Module2.algorithm(x_count, n)  'See subroutine code
            Sheets(i).Select                    'Return to frame of reference
            Range("D15").Select

        Loop            'syntax for continuation of while loop

    i = i + 1

Next i                  'syntax for continuation of for loop


If (x_count > 5) Then               'Bring user back to the Summary Page where...
                                    '...the last Item was logged
    Sheets("SUMMARY P.2").Select

Else

    Sheets("SUMMARY P.1").Select

End If

End Sub

然后是算法代码：

Sub algorithm(x_count As Long, n As Long)

Dim item_a As String    'Letter part of Item
Dim item_b As String    'Number part of Item

        'If an "x" or "X" is marked in the "Yes" column,
        'at descending cells down the column offset by the for loop index, n

        If (ActiveCell.Offset(n, 0) = "x" Or ActiveCell.Offset(n, 0) = "X") Then

            item_a = ActiveCell.Offset(n, -3).Value     ' Store Letter value
            item_a = Replace(item_a, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_a = Replace(item_a, ")", "")           ' characters that are grabbed
            item_a = Replace(item_a, " ", "")

            item_b = ActiveCell.Offset(n, -2).Value     ' Store number value
            item_b = Replace(item_b, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_b = Replace(item_b, ")", "")           ' characters that are grabbed
            item_b = Replace(item_b, " ", "")

            x_count = x_count + 1                       ' increment the total x count

          If (x_count > 5) Then                       ' If there are more than 5 "x" marks,

              Sheets("SUMMARY P.2").Activate          ' then continue to log in SUMMARY P.2
              Range("A18").Select                     ' Choose "Item" column, first cell
              ActiveCell.Offset((x_count - 6), 0).Value = (item_a & item_b)

              'Insert cocatenated value of item_a and item_b
              '(for example "A" & "1" = "A1")
              'at the cells under the "Item" column, indexed by x_count

          Else                                        ' If there are less than 5 "x" marks,

              Sheets("SUMMARY P.1").Activate          ' log in SUMMARY P.1
              Range("A25").Select                     ' Choose "Item" column, first cell
              ActiveCell.Offset((x_count - 1), 0).Value = (item_a & item_b)

          End If

        End If

  n = n + 1

结束子

【参考方案1】：

[编辑]：根据新信息更新代码：

Sub DSR_Autofill()

    Dim wsSummary1 As Worksheet
    Dim wsSummary2 As Worksheet
    Dim rngFound As Range
    Dim arrSummary1(1 To 5) As String
    Dim arrSummary2(1 To 65000) As String
    Dim strFirst As String
    Dim strTemp As String
    Dim DataIndex1 As Long
    Dim DataIndex2 As Long
    Dim xCount As Long
    Dim i As Long

    Set wsSummary1 = Sheets("SUMMARY P.1")
    Set wsSummary2 = Sheets("SUMMARY P.2")

    wsSummary1.Range("A25:A29").ClearContents
    wsSummary1.Range("A18:A" & Rows.Count).ClearContents

    For i = Sheets("Process Controls").Index To Sheets("Product Stewardship").Index
        With Sheets(i).Range("D15", Sheets(i).Cells(Rows.Count, "D").End(xlUp))
            Set rngFound = .Find("x", .Cells(.Cells.Count), xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    strTemp = Replace(Replace(Replace(Sheets(i).Cells(rngFound.Row, "A").Text & Sheets(i).Cells(rngFound.Row, "B").Text, "(", ""), ")", ""), " ", "")
                    If xCount < 5 Then
                        DataIndex1 = DataIndex1 + 1
                        arrSummary1(DataIndex1) = strTemp
                    Else
                        DataIndex2 = DataIndex2 + 1
                        arrSummary2(DataIndex2) = strTemp
                    End If
                    xCount = xCount + 1
                    Set rngFound = .Find("x", rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        End With
    Next i

    If DataIndex1 > 0 Then wsSummary1.Range("A25").Resize(DataIndex1).Value = Application.Transpose(arrSummary1)
    If DataIndex2 > 0 Then wsSummary2.Range("A18").Resize(DataIndex2).Value = Application.Transpose(arrSummary2)

    If xCount > 5 Then wsSummary2.Select Else wsSummary1.Select

End Sub

【讨论】：

这个答案肯定改进了我的代码，因为现在我可以让算法在一张纸上工作，但我仍然有一个错误。例如，如果我注释掉“for”和“Next”行并仅引用“Sheets(5)”，它就会起作用。但是一旦我把 for 循环放回去，它就根本不起作用。

如果没有看到您的代码，我真的无法告诉您更多信息。就像我说的，我不知道被调用的“算法”代码中有什么。问题很可能出在某个地方。

我了解您的代码及其很棒，但是您知道我的方法中的错误在哪里吗？

您将非全局变量（在这种情况下为 x_count 和 n）传递给您的第二个子，并尝试在那里更新它，而不是在您的主子中。这意味着这些变量永远不会更新，导致您的工作无法正常运行。一般来说，全局变量是不受欢迎的（尽管在某些情况下需要它们），所以我重写了你的代码，使它不需要它们。我也认为没有理由拥有算法辅助子，所以我只是将它与主算法合并。

我明白了，还有一个问题：在工作表之前使用“with”和只使用“.select”有什么区别？