WorksheetFunction.Match 无法粘贴/运行

Question

我最近将我的工作 Microsoft 帐户从 Excel 2010 升级到 Excel 2016。

虽然我还有 Excel 2010，但我编写了一系列宏来自动执行一项相当繁琐的任务。迁移到 Excel 2016 后，我的一个 VBA 脚本似乎已“损坏”。

下面是脚本：

Sub RunMacro()

Sheets("Control1").Select

'Step 1: #Script searches for header matches in Control1 dataset, then will copy in next
'step to Data list

    With Sheets("Control1")

        Route_Name = WorksheetFunction.Match("ROUTE_NAME", Rows("1:1"), 0)
        Feature_Type = WorksheetFunction.Match("FEATURE_TYPE", Rows("1:1"), 0)
        Shape_Length = WorksheetFunction.Match("SHAPE_LENGTH", Rows("1:1"), 0)


'Step 2: #Data transfer process

        Sheets("Control1").Columns(Route_Name).Copy Destination:=Sheets("Data").Range("A7")
        Sheets("Control1").Columns(Feature_Type).Copy Destination:=Sheets("Data").Range("B7")
        Sheets("Control1").Columns(Shape_Length).Copy Destination:=Sheets("Data").Range("T7")

    End With

End Sub

当我运行脚本时，我收到一个运行时错误“1004”，指出：“您不能在此处粘贴它，因为复制区域和粘贴区域的大小不同。在粘贴区域或相同大小的区域，然后再次尝试粘贴。”

困难在于，这个脚本在 Excel/VBA 2010 中运行没有问题。这个脚本可能存在什么问题，或者，是否存在潜在的宏安全设置限制它正常运行？

感谢您的帮助。

Answer 1

总是声明你的变量：

Dim Route_Name As Long
Dim Feature_Type As Long
Dim Shape_Length As Long

您没有使用您设置的 With Block。您需要在使用该父级的任何范围之前加上.

.Rows("1:1")

使用 Intersect 仅复制使用的区域：

Intersect(.UsedRange, .Columns(Route_Name)).Copy Destination:=Sheets("Data").Range("A7")

所以：

Sub RunMacro()

Dim Route_Name As Long
Dim Feature_Type As Long
Dim Shape_Length As Long

'Step 1: #Script searches for header matches in Control1 dataset, then will copy in next
'step to Data list

    With Sheets("Control1")

        Route_Name = WorksheetFunction.Match("ROUTE_NAME", .Rows("1:1"), 0)
        Feature_Type = WorksheetFunction.Match("FEATURE_TYPE", .Rows("1:1"), 0)
        Shape_Length = WorksheetFunction.Match("SHAPE_LENGTH", .Rows("1:1"), 0)


'Step 2: #Data transfer process


        Intersect(.UsedRange, .Columns(Route_Name)).Copy Destination:=Sheets("Data").Range("A7")
        Intersect(.UsedRange, .Columns(Feature_Type)).Copy Destination:=Sheets("Data").Range("B7")
        Intersect(.UsedRange, .Columns(Shape_Length)).Copy Destination:=Sheets("Data").Range("T7")

    End With

End Sub

---

还有一点：

如果第一行中不存在任何查找，这将失败。有很多方法可以捕捉和处理这个问题。

我喜欢直接使用On Error Resume Next 和On Error Goto 0，这样只会跳过这三行的错误。然后，Ifs 将仅在找到该列时复制：

Sub RunMacro()

Dim Route_Name As Long
Dim Feature_Type As Long
Dim Shape_Length As Long

'Step 1: #Script searches for header matches in Control1 dataset, then will copy in next
'step to Data list

    With Sheets("Control1")
        On Error Resume Next
            Route_Name = WorksheetFunction.Match("ROUTE_NAME", .Rows("1:1"), 0)
            Feature_Type = WorksheetFunction.Match("FEATURE_TYPE", .Rows("1:1"), 0)
            Shape_Length = WorksheetFunction.Match("SHAPE_LENGTH", .Rows("1:1"), 0)
        On Error GoTo 0

'Step 2: #Data transfer process

        If Route_Name Then _
            Intersect(.UsedRange, .Columns(Route_Name)).Copy Destination:=Sheets("Data").Range("A7")
        If Feature_Type Then _
            Intersect(.UsedRange, .Columns(Feature_Type)).Copy Destination:=Sheets("Data").Range("B7")
        If Shape_Length Then _
            Intersect(.UsedRange, .Columns(Shape_Length)).Copy Destination:=Sheets("Data").Range("T7")

    End With

End Sub