2014-09-24 79 views
0

以下是VBA中Excel2010的宏。它只在打開VBA代碼編輯器並從Debug菜單運行時才起作用。我試圖把它放到絲帶,並從那裏運行它,但我得到這個錯誤:從功能區運行工作宏時出錯

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 
+1

嘗試使用ThisWorkbook將引用原始工作簿而不是ActiveWorkbook – duDE 2014-09-24 13:22:06

+0

我已經對其進行了更改。我沒有注意到其中的差異。錯誤仍然存​​在。還有一些我還不知道的東西,我嘗試確定問題出在哪裏,但我在Excel VBA中沒有太多經驗。 Stack Exchange是Q/A網站。我在這裏沒有做錯任何事! 我不知道爲什麼我收到-2。我已經問過這個問題,並給出了這個例子。 – Celdor 2014-09-24 17:26:10

+1

我不知道你爲什麼得到-2,無論如何,從我+1作爲一個小安慰:) – duDE 2014-09-24 17:32:18

回答

1

嘗試以下方法:

Sub CopyAndRearrange(Control as IRibbionControl) 

添加控制允許從RIBBION執行的代碼。

+0

這不僅僅是。當我今天重新打開文件時,它無法完全運行。 – Celdor 2014-09-25 07:51:26

0

我想我找到了自己的問題的答案。

的問題是缺少支架在這一行:

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

這應該是:

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

如果錯誤是更容易理解,我也不會失去2天尋找這個問題:/