1

您好，社区，并提前感谢您的帮助。我创建了一个工作簿，其中包含可变数量的工作表，其中大多数具有变量名称。但是，有 4 个工作表不会更改，我不希望从中复制数据。我正在尝试的代码如下：如果我离基地很远，请告诉我。

V/R 道格

Private Sub GroupReport_Click()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim Disreguard(1 To 4) As String

Disreguard(1) = "RDBMergeSheet"
Disreguard(2) = "0 Lists"
Disreguard(3) = "0 MasterCrewSheet"
Disreguard(4) = "00 Overview"

   ' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"


' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> Disreguard.Worksheets.Name Then
        Last = LastRow(DestSh)
        Set CopyRng = sh.Rows("21")
        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next
4

1 回答 1

1

不幸的是，这条线对你不起作用：

If sh.Name <> Disreguard.Worksheets.Name Then

Disreguard 变量是一个数组，但不是 VBA 中的对象，因此您无法使用点运算符访问任何方法。您必须遍历数组的内容并根据您正在测试的字符串检查每个项目。

您可以添加一个函数来测试它，如下所示：

Private Function toDisreguard(ByRef list() as String, ByRef searchString As String) As Boolean
    Dim i As Long
    For i = LBound(list) To UBound(list)
        If (searchString = list(i)) Then
            toDisreguard = True
            Exit Function
        End If
    Next i

    toDisreguard = False
End Function

然后将数组与工作表名称一起传递以进行测试，如下所示：

If (toDisreguard(Disreguard, sh.Name) = False) Then

此外， LastRow() 函数不是从您发布的内容中定义的。这是您创建的功能吗？

事实上，您可以自己跟踪最后一行，因为您每次运行时都在重建“RDBMergeSheet”工作表。您可以从设置 Last = 1 开始，然后一路递增。最后一件事，您可能应该测试每张纸的第 21 行中是否有任何数据，这样您就不会复制空白行：

' Loop through all worksheets and copy the data to the
' summary worksheet.
Last = 1

For Each sh In ActiveWorkbook.Worksheets
    If (toDisreguard(Disreguard, sh.Name) = False) Then
        'Last = LastRow(DestSh)
        If (Application.WorksheetFunction.CountA(sh.Rows("21")) > 0) Then
            Set CopyRng = sh.Rows("21")
            CopyRng.Copy
            With DestSh.Cells(Last, "A") ' notice i changed this as well
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            Last = Last + 1
        End If
    End If
Next
于 2012-12-05T15:04:08.497 回答