0

我有一个要求,我有一组数据存储在“Sheet1”列A中,如下所示

Cat
Dog
Mouse
Horse

我还有另一本工作簿 - “Animaldetails.xlsx”,其中有几个选项卡,其中包含“Cat”、“Dog”、“Mouse”、“Horse”和其他几个名称

我需要将“sheet1”中的所有值搜索到“Animaldetails.xlsx”选项卡中,并将每个选项卡中存在的所有数据复制到单独的工作表中 - “sheet2”

谈到我所做的,我尝试了 .Find 方法,但我只能为 1 个单元格而不是多个值。我可以在工作表中搜索,但我想在工作簿的选项卡中搜索

我知道这可以使用INDIRECT函数来实现,但我希望通过 VBA 来实现

4

1 回答 1

1

要查找名称为 conaiting 的工作表,Cat您需要遍历所有工作表并将其名称与Cat.

例子:

Dim Wb As Workbook
Set Wb = Application.Workbooks("Animaldetails.xlsx")  'or set any other workbook

Dim Ws As Worksheet
For Each Ws In Wb.Worksheets 'loop through all worksheets
    If Ws.Name Like "*Cat*" Then  'note the asterisks as placeholder
        'the worksheet Ws has `Cat` in its name
    End If
Next Ws

不仅要检查,Cat还要检查所有其他人,您需要另一个循环来检查列表中所有名称的每个 W:

Dim Wb As Workbook
Set Wb = Application.Workbooks("Animaldetails.xlsx")  'or set any other workbook

Dim TestNameList() As Variant
TestNameList = ThisWorkbook.Worksheets("Sheet1").Range("A1:A10").Value 'adjust range to your data

Dim Ws As Worksheet
For Each Ws In Wb.Worksheets 'loop through all worksheets
    Dim TestName As Variant
    For Each TestName in TestNameList
        If Ws.Name Like "*" & TestName & "*" Then
            'the worksheet Ws has TestName in its name
            Debug.Print Ws.Name & " has " & TestName & " in its name."
            'your copy actions here
            'Ws.Range("A1").Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1") 'adjust to your needs

            'if every sheetname can only match one of the names then you can exit for here to fasten the code
            Exit For
        End If
    Next TestName
Next Ws

如果您的工作表名称准确 CatDog那么我们更容易直接使用它们:

Dim Wb As Workbook
Set Wb = Application.Workbooks("Animaldetails.xlsx")  'or set any other workbook

Dim TestNameList() As Variant
TestNameList = ThisWorkbook.Worksheets("Sheet1").Range("A1:A10").Value 'adjust range to your data

Dim TestName As Variant
For Each TestName in TestNameList
    Dim Ws As Worksheet
    Set Ws = Nothing
    On Error Resume Next  'next line throws error if sheet name does not exist
    Set Ws = Wb.Worksheets(TestName)
    On Error Goto 0  're-enable error reporting

    If Not Ws Is Nothing Then
        'Ws is now your worksheet with `TestName`

        'your copy actions here
        'Ws.Range("A1").Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1") 'adjust to your needs
    Else
        MsgBox "Worksheet '" & TestName & "' not found."
    End If
Next TestName
于 2020-05-08T07:47:25.070 回答