如何在同一列中搜索多个值？

Question

我有一个包含八张工作表的工作簿。第一个工作表是一个首页，其中包含工作簿中的所有数据，如果您愿意，可以作为主工作表。其余七个选项卡是团队的员工姓名。

我的代码将在 C 列中搜索名称并将包含该名称的整行复制到相应员工的个人工作表中。

我现在需要在同一列 (C) 中搜索其余工作人员的姓名，并将相应的行复制到相应的工作表中。

我当前的代码：

Private Sub CommandButton1_Click()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Front Page")
    Set Target = ActiveWorkbook.Worksheets("Charlotte")
    j = 2
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
        If c = "Charlotte Richardson" Then
            Source.Rows(c.Row).Copy Target.Rows(j)
            j = j + 1
        End If
    Next c
End Sub

Answer 1

试试这个 - 虽然您必须将工作表名称添加到数组 arr1，并将您要查找的全名添加到数组 arr2：

Private Sub CommandButton1_Click()

    Dim c As Range
    Dim j As Long, i as Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim arr1 As Variant, arr2 As Variant

    arr1 = Array("Charlotte", "Mikey", "Bob")
    arr2 = Array("Charlotte Richardson", "Mikey Joe", "Bob Vann")

    'Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Front Page")

    'Start copying to row 2 in target sheet
    For i = 0 To UBound(arr1)

        j = 2
        Set Target = ActiveWorkbook.Worksheets(arr1(i))

        For Each c In Source.Range("C1:C1000") ' Do 1000 rows
            If c = arr2(i) Then
                Source.Rows(c.Row).Copy Target.Rows(j)
                j = j + 1
            End If
        Next c

    Next i

End Sub

Answer 2

如果您要使用您正在寻找的确切名称（“Charlotte Richardson”，而不是“Charlotte”）来命名您的床单，那么您可以使用这个：

Private Sub CommandButton1_Click()
  Dim c As Range
  Dim j As Integer, i As Integer
  Dim Source As Worksheet

  Set Source = ActiveWorkbook.Worksheets("Front Page")
  For i = 2 To ActiveWorkbook.Sheets.Count 'Assuming that "Front Page" is your first sheet
    j = 2
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
      If c.Value2 = ActiveWorkbook.Worksheets(i).Name Then
        Source.Rows(c.Row).Copy ActiveWorkbook.Worksheets(i).Rows(j)
        j = j + 1
      End If
    Next c
  Next
End Sub

这样做的好处是，当您必须添加员工时，您所要做的就是添加一个具有正确名称的新工作表，您的代码无需任何修改即可运行。

Answer 3

阵列解决方案

强烈建议您创建原始文件的副本并首先在其中测试代码。打开工作簿并转到 SaveAs 并用另一个名称保存它，例如“测试”或其他名称。现在您可以“玩”了。

在使用此代码之前，您必须在代码的“自定义”部分手动输入数据。

这样的代码最好保留七张纸中的旧数据并仅更新（添加新行），但它总是删除（清除内容）从第 2 行开始的七张纸中的旧数据，之前添加新数据。此外，代码没有错误处理。

另一方面，代码做了它应该做的事情。如果出现问题，“首页”工作表没有危险，因此如果其他工作表发生问题，您可以随时重新创建它们。

Private Sub CommandButton1_Click()
  Dim c As Range
  Dim i As Integer
  Dim j As Integer
  Dim Source As Worksheet
  Dim Target As Worksheet
  Dim arr() As String
  'Create an array of data
  ReDim arr(1 To 7, 1 To 2) As String
'-- Customize BEGIN --------------------
  'Sheet Names
  arr(1, 1) = "Charlotte"
  arr(2, 1) = ""
  arr(3, 1) = ""
  arr(4, 1) = ""
  arr(5, 1) = ""
  arr(6, 1) = ""
  arr(7, 1) = ""
  'Names in column 'C'
  arr(1, 2) = "Charlotte Richardson"
  arr(2, 2) = ""
  arr(3, 2) = ""
  arr(4, 2) = ""
  arr(5, 2) = ""
  arr(6, 2) = ""
  arr(7, 2) = ""
'-- Customize END ----------------------

  Set Source = ActiveWorkbook.Worksheets("Front Page")

  For i = 1 To 7
    j = 2
    Set Target = ActiveWorkbook.Worksheets(arr(i, 1))
    ' ClearContents of Target
    Target.Range(j & ":" & Target.Rows.Count).ClearContents
    ' Start copying to row 2 in target sheet
    For Each c In Source.Range("C1:C1000") ' Do 1000 rows
      If c = arr(i, 2) Then
        Source.Rows(c.Row).Copy Target.Rows(j)
        j = j + 1
      End If
    Next
  Next
End Sub

要完全理解代码，您应该阅读有关数组、循环、范围以及您在代码中看到的任何关键字。