查找然后复制/通过Excel VBA

Question

我正在尝试从一个选项卡到另一个选项卡查找/复制并通过一些列。

这是我的代码：

Sheets("Past Inventory Here").Select
code = WorksheetFunction.Match("No.", Rows("1:1"), 0)
desc = WorksheetFunction.Match("Description", Rows("1:1"), 0)
stat = WorksheetFunction.Match("Item Status", Rows("1:1"), 0)
sale = WorksheetFunction.Match("Qty. on Sales Order", Rows("1:1"), 0)
purc = WorksheetFunction.Match("Qty. on Purch. Order", Rows("1:1"), 0)
inv = WorksheetFunction.Match("Inventory", Rows("1:1"), 0)
**meas = WorksheetFunction.Match("Base Unit of Measure", Rows("1:1"), 0)**
Sheets("Past Inventory Here").Columns(code).Copy Destination:=Sheets("Inventory").Range("A1")
Sheets("Past Inventory Here").Columns(desc).Copy Destination:=Sheets("Inventory").Range("B1")
Sheets("Past Inventory Here").Columns(stat).Copy Destination:=Sheets("Inventory").Range("C1")
Sheets("Past Inventory Here").Columns(sale).Copy Destination:=Sheets("Inventory").Range("D1")
Sheets("Past Inventory Here").Columns(purc).Copy Destination:=Sheets("Inventory").Range("E1")
Sheets("Past Inventory Here").Columns(inv).Copy Destination:=Sheets("Inventory").Range("F1")
Sheets("Past Inventory Here").Columns(meas).Copy Destination:=Sheets("Inventory").Range("G1")

)

我总是在这一行遇到一个错误**，如果我删除它，代码就会正常工作。

你能帮忙吗

非常感谢提前

Answer 1

您可能需要为每一个执行此操作。如果没有匹配项，它就会跳过它。你可能想添加一个消息框来提醒你，或者在单元格中填充一条消息，声明"未找到"或类似的内容。MSDN获取更多信息。

If Not IsError(Application.Match("Description", Rows("1:1"), 0)) Then
    desc = Application.Match("Description", Rows("1:1"), 0)
    Sheets("Past Inventory Here").Columns(desc).Copy Destination:=Sheets("Inventory").Range("B1")
else
    MsgBox " does not exist in range "
End If

Answer 2

我的猜测是标题并不完全相同。"基本计量单位"的开头或结尾是否有空白？如果你确切地知道它在哪里（比如说在L1 fore实例中），你可以尝试下面的代码。只需在尝试设置meas变量之前添加它。在弹出窗口中，你会得到文本，这样你就可以逐个比较它们是否相同。结尾的>需要彼此完全一致：

MsgBox "<Base Unit of Measure> = " & Len("Base Unit of Measure") _
  & vbNewLine _
  & "<" & Range("L1").Value & "> = " & Len(Range("L1").Value)