Question

我写了这段代码来查找单词的行，然后取一列（每个单词都相同）并将其复制到另一列。如果您看下面的代码，这将更有意义。如果该列中存在紫色，蓝色等单词，则此代码有效，但是如果单词不存在，则会出现错误消息。我尝试使用错误处理程序“下一个错误恢复”，当我尝试查找颜色并且没有选择正确的数字并从excel中选择一个随机数时，它就可以工作（例如，“ 1”在最后一行中没有正确选择。）

这是我现在拥有的代码。我只是在寻找将其放入循环或函数中的指南。

Employee.Cells(.Find("Purple").Row, "D").Copy GroupWS.Range("H15")
Employee.Cells(.Find("Red").Row, "D").Copy GroupWS.Range("H16")
Employee.Cells(.Find("Green").Row, "D").Copy GroupWS.Range("H17")
Employee.Cells(.Find("Blue").Row, "D").Copy GroupWS.Range("H18")
Employee.Cells(.Find("Yellow").Row, "D").Copy GroupWS.Range("H19")
Employee.Cells(.Find("Orange").Row, "D").Copy GroupWS.Range("H20")
Employee.Cells(.Find("White").Row, "D").Copy GroupWS.Range("H21")
Employee.Cells(.Find("1").Row, "D").Copy GroupWS.Range("H21")

Answer 1

这将是循环：

Option Explicit
Sub Test()

    Dim Employee As Worksheet, GroupWS As Worksheet
    Dim i As Long
    Dim arr As Variant

    arr = Array("Purple", "Red", "Green", "Blue", "Yellow", "Orange", "White", "1")
    For i = LBound(arr) To UBound(arr)
        With Employee
            .Cells(.Cells.Find(arr(i)).Row, "D").Copy GroupWS.Range("H" & 15 + i)
        End With
    Next i

End Sub

您只需将要查找的项目填充到数组中，然后遍历它。请注意，数组的构建从0开始，因此第一个i = 0。

编辑：注意到您的上一个复制粘贴与以前的粘贴到同一单元格了，这是您的预期目标吗？

Edit2：这将带有可重复使用的子过程：

Option Explicit
Sub Test()

    Dim Employee As Worksheet, GroupWS As Worksheet

    CopyValue "Purple", Employee, GroupWS, "H15"

End Sub
Sub CopyValue(StrCopy As String, wsOrigin As Worksheet, wsTarget As Worksheet, Cell As String)

    With wsOrigin
        .Cells(.Cells.Find(StrCopy).Row, "D").Copy wsTarget.Range(Cell)
    End With

End Sub

有什么办法可以在VBA excel中压缩此代码？也许使用循环或功能

1 个答案: