从多个工作表中收集数据集时的无限循环

Question

这是我第一次用 VBA 编写代码。 我在一个文件中有几个工作表，它们按日期排列。 所以我想做的是在工作表中收集数据集，如果它们有相同的时间段。

日期1值1
日期 2 值 2
日期3值3

由于它们是有序的，我只比较第一个日期值，如果它们不同，则转到下一个工作表。如果它们相同，则复制该值并执行相同的过程，直到到达最后一个工作表。 但是它可以很好地复制一个工作表，但之后 Excel 会冻结。

如果您发现任何错误或给我其他建议，我们将不胜感激。
以下是我的代码：

Sub matchingStock()

Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")

Dim col As Long

'since first column is for Tbill it stock price should place from the third column
col = 3

Dim k As Long

'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
    Set sh2 = Sheets(k)

    ' Create iterators
    Dim i As Long, j As Long

    ' Create last rows values for the columns you will be comparing
    Dim lr1 As Long, lr2 As Long

    ' create a reference variable to the next available row
    Dim nxtRow As Long

    ' Create ranges to easily reference data
    Dim rng1 As Range, rng2 As Range

    ' Assign values to variables
    lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row

    If sh1.Range("A3").Value = sh2.Range("A3").Value Then
        Application.ScreenUpdating = False

        ' Loop through column A on sheet1
        For i = 2 To lr1
            Set rng1 = sh1.Range("A" & i)

            ' Loop through column A on sheet1
            For j = 2 To lr2
                Set rng2 = sh2.Range("A" & j)

                ' compare the words in column a on sheet1 with the words in column on sheet2
                'Dim date1 As Date
                'Dim date2 As Date

                'date1 = TimeValue(sh1.Range("A3"))
                'date2 = TimeValue(sh2.Range("A3"))

                sh1.Cells(1, col).Value = sh2.Range("A1").Value

                ' find next empty row
                nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1

                ' copy the word in column A on sheet2 to the next available row in sheet1
                ' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
                sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value

                'when the date is different skip to the next worksheet
                Set rng2 = Nothing
            Next j
            Set rng1 = Nothing
        Next i
        'sh3.Rows("1:1").Delete
        Else
            GoTo Skip
        End If
Skip:
col = col + 1
Next k
End Sub

Answer 1

我无法识别特定错误，因此这是一个建议列表，可以帮助您识别错误并可能有助于改进您的代码。

建议 1

你认为 If-Then-Else-End-If 的 Else 块是强制性的吗？

  If sh1.Range("A3").Value = sh2.Range("A3").Value Then
    :
  Else
    GoTo Skip
  End If
Skip:

等同于：

  If sh1.Range("A3").Value = sh2.Range("A3").Value Then
    :
  End If

建议 2

我不喜欢：

For k = Sheets("WLT").Index To Sheets("ARNA").Index

工作表的属性 Index 的值可能不是您想象的那样。这可能不会为您提供您期望的工作表集或序列。您想要除“组合”之外的所有工作表吗？以下应该更可靠：

For k = 1 To Worksheets.Count
  If Worksheets(k).Name <> sh1.Name Then
    :
  End If
Next

建议 3

你使用：

.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)

所有这些识别单元格或范围的方法都有其用途。但是，我发现一次使用多个是令人困惑的。我发现 .Cells(row, column) 和 .Range(.Cells(row1, column1), .Cells(row2, column2)) 是最通用的，除非有充分的理由使用其他方法之一，否则使用它们。

建议 4

我无法破译这段代码试图达到的目的。

您说：“我在一个文件中有几个工作表，它们按日期排列。所以我想做的是在工作表中收集数据集，如果它们具有相同的时间段。”

如果您已将Worksheet("combined").Range("A3").Value 设置为特定日期，并且您想从单元格 A3 中具有相同值的所有工作表中收集数据，则外部 For-Loop 和 If 会产生此效果。但如果是这样，那么工作表的排序方式就无关紧要了。您还开始检查第 2 行的单元格值，这表明第 3 行是常规数据行。

外循环用于每个工作表，下一个循环用于“组合”中的每一行，内循环用于外循环选择的工作表中的每一行。中间循环似乎没有做任何事情，只是设置了未使用的rng1。

也许您可以添加对您要达到的目标的解释。

建议 5

您是否尝试将源工作表中的一整列值添加到“组合”中。下面的宏：

• 标识“组合”的 A 列中的下一个空闲行
• 标识“Sheet2”的 A 列中最后使用的行
• 假设“Sheet2”的第一个有趣的行是 2。
• 在单个语句中将“Sheet2”的 A 列（包含格式）的整个使用范围添加到“Combined”的 A 列的末尾。

这可能展示了一种更好的方式来实现您所寻求的效果。

Sub Test()

  Dim RngSrc As Range
  Dim RngDest As Range
  Dim RowCombNext As Long
  Dim RowSrcFirst As Long
  Dim RowSrcLast As Long

  With Worksheets("Combined")
    RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set RngDest = .Cells(RowCombNext, "A")
  End With

  With Worksheets("Sheet2")
    RowSrcFirst = 2
    RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
    Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
  End With

  RngSrc.Copy Destination:=RngDest

End Sub