Question

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

date1 value1
date2 value2
date3 value3

由于它们是有序的，我只是比较第一个日期值，如果它们不同，它会转到下一个工作表。如果它们相同，则复制该值并执行相同的过程，直到它到达最后一个工作表。然而，它复制了一个工作表，但在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

你认为Ifse-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

工作表的属性索引值可能不是您认为的。这可能无法提供您期望的工作表集或序列。你想要除“合并”之外的每个工作表吗？以下应该更可靠：

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

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

标识“合并”
标识“Sheet2”
假设第一个有趣的“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

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

1 个答案: