阵列解决方案

Question

好的，所以我将尝试尽可能清楚地写出措辞...

我创建了一个电子表格，其中共有8个工作表。第一页是首页，其中包含工作簿中的所有数据；如果愿意，则为母版。

其余7个标签是团队的职员名称。我已经创建了一个命令按钮，它将在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

阵列解决方案

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

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

理想情况下，这样的代码应保留七个工作表中的旧数据并仅进行更新（添加新行），但始终会删除（ClearContents），从第二行开始的七个工作表中的旧数据，然后添加新数据。此外，该代码还没有错误处理。

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

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

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

编辑命令按钮宏以在同一列中搜索多个单元格值

3 个答案:

阵列解决方案