Question

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

虽然我还有Excel 2010，但我编写了一系列宏来自动执行一项非常繁琐的任务。移动到Excel 2016后，我的一个VBA脚本似乎已经打破了＃34;。

以下是剧本：

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

当我运行脚本时，收到运行时错误＆＃39; 1004＆＃39;，声明：＆＃34;您无法在此处粘贴此内容，因为复制区域和粘贴区域不是＆＃39 ; t相同的大小。只需在粘贴区域中选择一个单元格或选择相同大小的区域，然后再次尝试粘贴。＆＃34;

困难在于，此脚本在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(.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这将只跳过这三行的错误。然后If只会在找到列时复制：

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

WorksheetFunction.Match无法粘贴/运行

1 个答案: