Question

我有一个像这样的表：

arr[0]

我正在使用的代码如下所示：

Pendergrass (606)-663-4567
Rich        (606)-667-4567
Scott       (606)-987-4567
Dennis      (606)-233-4567
David       (606)-888-4567
Red         (606)-567-4567
Wendy       (606)-765-4567
Todd        (606)-677-4567
Andrea      (606)-780-3451
Caroline    (606)-992-7865

我想要获取Private Sub CommandButton2_Click() Dim ws As Worksheet, bFound As Boolean, rFound As Range Dim a As Long, aNames As Variant aNames = Array("David", "Andrea", "Caroline") For Each ws In ThisWorkbook.Worksheets 'If ws.Name <> Worksheets("Report").Name Then If ws.Name = "Sheet1" Then With ws.Range("A1:E30").Cells For a = LBound(aNames) To UBound(aNames) Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) If Not rFound Is Nothing Then bFound = True With Worksheets("Report") .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = rFound.Value End With End If Next a End With End If Next ws If Not bFound Then MsgBox "None of the sheets contains the names " & Chr(10) & _ "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found" End If End Sub，David和Andrea的数字，并将它们放在Caroline页面的任何位置。这只能抓住一个。

任何人都可以建议我在这个代码出错的地方吗？

Answer 1

尝试以下代码。

但是，不确定为什么要使用For Each ws In ThisWorkbook.Worksheets循环遍历所有工作表，如果在以下行检查If ws.Name = "Sheet1" Then。

您可以替换以下行（删除For，With和If）：

For Each ws In ThisWorkbook.Worksheets
    With ws
        'If ws.Name <> Worksheets("Report").Name Then
        If .Name = "Sheet1" Then
            With .Range("A1:E30").Cells

简单：

With Worksheets("Sheet1").Range("A1:E30").Cells

<强>代码

Private Sub CommandButton2_Click()

    Dim ws As Worksheet, bFound As Boolean, rFound As Range
    Dim a As Long, aNames As Variant

    aNames = Array("David", "Andrea", "Caroline")

    For Each ws In ThisWorkbook.Worksheets
        With ws
            'If ws.Name <> Worksheets("Report").Name Then
            If .Name = "Sheet1" Then
                With .Range("A1:E30").Cells
                    For a = LBound(aNames) To UBound(aNames)
                        Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False)
                        If Not rFound Is Nothing Then
                            bFound = True
                            Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(1) = rFound.Value
                            Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(, 1) = rFound.Offset(, 1).Value
                        End If
                    Next a
                End With
            End If
        End With
    Next ws

    If Not bFound Then
        MsgBox "None of the sheets contains the names " & Chr(10) & _
            "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found"
    End If

End Sub

在工作表值中查找数组数据

1 个答案: