Question

下面是VBA中Excel2010的宏。它只在我打开VBA代码编辑器并从菜单Debug运行时才有效。我试着把它放到Ribbon上并从那里运行但是我有这个错误：

Run-time error '1004':
Application-defined or object-defined error

此外，当我将所有Range()更改为.Worksheet(i).Range()时，该过程根本不会以相同的错误运行。就像.Range似乎不是Worksheet（i）的一部分。我没有Excel 2010 VBA的经验。

Sub CopyAndRearrange()
    Dim ns As Integer
    Dim i As Integer

    ns = ActiveWorkbook.Worksheets.Count
    ActiveWorkbook.Sheets(ns).Cells.ClearContents

    For i = 1 To ns - 1
        With ActiveWorkbook
            .Worksheets(i).Activate
            Range("E1") = CInt(.Worksheets(i).Name)
            Range(Range("G1"), Range("A1").End(xlDown).Offset(0, 7)) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"
            Range(Range("I1"), Range("A1").End(xlDown).Offset(0, 8)) = "=RC[-6]"

            Range(Range("G1"), Range("I1").End(xlDown)).Copy
            Sheets(ns).Activate
            If i = 1 Then
                'Range(Range("G1"), Range("I1").End(xlDown)).Copy Destination:=Sheets(ns).Range("A1")
                Sheets(ns).Range("A1").Select
            Else
                'Range(Range("G1"), Range("I1").End(xlDown)).Copy Destination:=Sheets(ns).Range("A1").End(xlDown).Offset(1, 0)
                Sheets(ns).Range("A1").End(xlDown).Offset(1, 0).Select
            End If
            ActiveSheet.Paste Link:=True
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        End With
    Next
    Sheets(ns).Range("A1").Select
End Sub

<小时/> 编辑：好。我稍微改变了代码，希望我提到正确的表格等错了。问题仍然存在。行：ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"导致问题。令人惊讶的是，这不是我在活动表中引用Range的第一个，出于某些原因，我真的不知道为什么，我有错误！为了穷尽所有可能性，我也尝试了这些：

在VBA窗口中显式重新创建模块
重新打开文件
录制宏并在其中插入代码

到目前为止，没有任何工作。我放弃了，但未来可能有人会看到问题，并在此提出解决方案。

Public Sub CopyAndRearrange()
    Dim ns As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim rg1 As Range
    Dim rg2 As Range
    Dim cell As Range

    Set wb = ThisWorkbook
    ns = wb.Worksheets.Count
    wb.Sheets(ns).Cells.ClearContents

    For i = 1 To ns - 1
        With wb
            Set ws = wb.Worksheets(i)
            ws.Activate

            ActiveSheet.Range("E1") = CInt(ActiveSheet.Name)

            Set rg1 = ActiveSheet.Range("G1")
            Set rg2 = ActiveSheet.Range("A1").End(xlDown).Offset(0, 7)
            ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"

            Set rg1 = ActiveSheet.Range("I1")
            Set rg2 = ActiveSheet.Range("A1").End(xlDown).Offset(0, 8)
            ActiveSheet.Range(rg1, rg2) = "=RC[-6]"

            Set rg1 = ActiveSheet.Range("G1")
            Set rg2 = ActiveSheet.Range("I1").End(xlDown)
            ActiveSheet.Range(rg1, rg2).Copy

            Sheets(ns).Activate
            If i = 1 Then
                ActiveSheet.Range("A1").Select
            Else
                ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
            End If
            ActiveSheet.Paste Link:=True
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        End With
    Next
    Sheets(ns).Range("A1").Select

    Set ws = Nothing
    Set wb = Nothing
    Set rg1 = Nothing
    Set rg2 = Nothing
    Set cell = Nothing
End Sub

Answer 1

尝试以下方法：

Sub CopyAndRearrange(Control as IRibbionControl)

添加控件允许从ribbion执行代码。

Answer 2

我想我找到了自己问题的答案。

问题是这行中缺少括号：

ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"

应该是：

ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5)"

如果错误更容易理解，我不会失去2天来寻找这个问题：/

从功能区运行工作宏时出错

2 个答案: