从function区运行工作macros时出错
以下是VBA中Excel2010的一个macros。 只有当我打开VBA代码编辑器并从Debug菜单运行时才能工作。 我试图把它放到function区并从那里运行，但我有这个错误：
Run-time error '1004': Application-defined or object-defined error 此外，当我将所有Range()更改为.Worksheet(i).Range() ，该过程完全不会运行，并且具有相同的错误。 这就像。范围似乎不属于工作表（一）。 我在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"导致的问题。请参阅活动工作表中的范围，出于某些原因，我真的不知道为什么，我得到了错误!!!要耗尽所有的可能性，我也试过这些：
- 在VBA窗口中显式重新创build一个模块
- 重新打开文件
- logging一个macros并在其中插入一个代码
到目前为止没有任何工作。 我已经放弃了，但也许以后有人会看到这个问题，并在这里给出一个解决scheme。
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
尝试以下操作：
Sub CopyAndRearrange(Control as IRibbionControl)
添加控件允许代码从ribbion执行。
我想我find了自己的问题的答案。
问题是在这一行中缺less括号：
ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"
应该是：
ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5)"
如果错误更容易理解，我不会失去2天来寻找这个问题：/