时间戳

首页 > 解决方案 > 有什么办法可以在 VBA excel 中压缩此代码？也许使用循环或函数

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

问题描述

我编写了这段代码来查找一个单词的行，并取一列（每个单词都相同）并将其复制到另一列。如果您查看下面的代码，它会更有意义。如果列中存在紫色、蓝色等单词，则此代码有效，但如果该单词不存在，则我会收到一条错误消息。我尝试使用错误处理程序“在错误恢复下一个”，当我试图找到一种颜色并且没有选择正确的数字并从 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")

标签： excelvba

解决方案

这将是循环：

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

推荐阅读