在 VBA 中存储字符串并输出到多个单元格

Question

我目前设置的代码将循环遍历我的工作簿中的所有工作表，将日期粘贴到一个单元格中，当该单元格非空白时，该行中的剩余单元格将填充数据。

在每一行的开头 - 我有一个公式，如果该行中的任何单元格中有错误，我会说“错误”。像这样：

然后我有另一个循环，它将遍历每个工作表并检查该单元格中是否存在错误，如果是，将转到工作簿中的第一张表到特定单元格并添加“xyz 错误标签”。如果有多个错误，它将转到下一行并粘贴。所以它看起来像这样：

我在考虑不是再次循环遍历每张纸，我可以将文本字符串存储在变量/数组中，然后以相同的方式将其粘贴到循环结束时的前纸上吗？

这是当前设置的错误循环的代码：

For I = 1 To WS_Count 
    ActiveWorkbook.Worksheets(I).Activate

    Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).End(xlDown).Offset(0, -1).Activate

    If ActiveCell.Value = "Error" Then        
        Application.Goto "ErrorCheck" 

        If ActiveCell.Offset(1, 0).Value = vbNullString Then
            ActiveCell.Offset(1, 0).Value = "Error on " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
        Else
            Selection.End(xlDown).Activate                
            ActiveCell.Offset(1, 0).Value = "Error on " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
        End If

    Else

    End If
Next I

Answer 1

因此，我个人不想使用数组。我更喜欢使用集合。这更容易，因为您不知道数组的参数，因此很难给它提供尺寸。

尽管如此，请在下面找到一个可能的解决方案。根据您的需要工作。我还没有测试或调试自己。但应该做的伎俩。

Sub ErrorCheck()

    Dim x As Long, lRow1 As Long, lRow2 As Long
    Dim myCollection As New Collection
    Dim ws As Worksheet
    Dim mySheet As Worksheet

    Set mySheet = Sheets("ErrorCheckSheet")

    'create the for loop to cycle through worksheets
    For Each ws In ThisWorkbook.Worksheets
        'set the lrow to iterate through column
        'set the colum for your need - "Error" column
        lRow1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        'IF lRow does not match your cell, use a static variable ie. 50
        'assuming your data starts in row 2 as per picture
        For x = 2 To lRow1
            'check each cell for error text
            If ws.Range("A" & x).Text = "Error" Then
                'when found add to collection
                'adjust to meet your cell you want to input into collection
                myCollection.Add ws.Range("B" & x).Text
            End If
        Next x
     Next ws
     'once you have completely cycled through your workbook your collection will now be loaded
    For x = 1 To myCollection.Count
        'set the lrow on the sheet you want to enter the data in
        lRow2 = mySheet.Range("U" & mySheet.Rows.Count).End(xlUp).Row + 1
        'now set the variable
        mySheet.Range("U" & lRow2).Value = "Error on" & myCollection(x)
    Next x

    Set myCollection = New Collection
    Set mySheet = Nothing

End Sub