[發問] 請高人幫忙除錯，謝謝~

198188

01.Option Explicit

02.Sub Ex()

03.   Dim Rng As Range

04.   'With Workbooks.Open("C:\USER\DESTOP\E.XLSX").Sheets("2012") '檔案未開啟時用此程式碼

05.   With Workbooks("E.XLSX").Sheets("2012")                      '檔案已開啟時用此程式碼

06.        'A2:AM2 to A100:AM100 是Y:\2012\A.XLSX (2012) 的資料

07.        Set Rng = .[A2]

08.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案開啟

09.            .[A100:AM100].Copy Rng   “請問如果我的資料不停增加，超過100列，這句是不是需要改？

10.           .Parent.Close False                                  '檔案關閉

11.        End With

12.        'A101:AM101 to A150:AM150是C:\2012\B.XLSX (Nov)的資料

13.        Set Rng = Rng.End(xlDown).Offset(1)  

14.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("Nov")    '檔案開啟

15.            .[A150:AM150].Copy Rng   “請問如果我的資料不停增加，超過150列，這句是不是需要改？

16.           .Parent.Close False                                  '檔案關閉

17.        End With

18.        'A151:AM151 to A270:AM270是Z:\2012\C.XLSX (2012) 的資料

19.        Set Rng = Rng.End(xlDown).Offset(1)

20.        With Workbooks.Open("Y:\2012\A.XLSX").Sheets("2012")    '檔案未開啟

21.            .[A270:AM270].Copy Rng   “請問如果我的資料不停增加，超過270列，這句是不是需要改？

22.           .Parent.Close False                                  '檔案關閉

23.        End With

24.    End With

25.End Sub



Set Rng = Rng.End(xlDown).Offset(1)  這句出現run-time error '1004' application-defined or object-defined error
.[A100:AM100].Copy Rng   “請問如果我的資料不停增加，超過100列，這句是不是需要改？
.[A150:AM150].Copy Rng   “請問如果我的資料不停增加，超過150列，這句是不是需要改？
.[A270:AM270].Copy Rng   “請問如果我的資料不停增加，超過270列，這句是不是需要改？

198188

回復 53# GBKEE


    請問為何這個file會有10MB，只有這個程式，其他的都沒有？

GBKEE

回復 52# 198188

   

下載 (41.78 KB)

2012-12-9 08:03

如圖操作可方便他人複製程式碼
簡化你的程式碼

1. Option Explicit
   
2. Sub Ex()
   
3.    Dim Rng(1 To 2) As Range, Files_AR(), E As Variant
   
4.      Files_AR = Array("Connie.XLSX", "Lily.XLSX", "Jane.XLSX", "Jenny.XLSX")
   
5.                                                                        '檔案名稱置入陣列:簡化程式的書寫
   
6.      With Workbooks("payment.XLSM").Sheets("2012")
   
7.         .Range("A2:L65536").ClearContents
   
8.         .Range("A2:L65536").Interior.Color = xlNone
   
9.         .Range("A1").CurrentRegion.Offset(1) = ""                       '清除A1連續範圍Offset(1):第一列以後連續範圍資料
   
10.         For Each E In Files_AR                                          '迴圈取同一資料夾的檔案
    
11.             Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(1)  'Offset(2)=> 本身算起如是E1-> E3
    
12.             With Workbooks.Open("C:\Documents and Settings\USER\桌面\" & E).Sheets("SHEET1")
    
13.                 Set Rng(2) = .[A2:L2]
    
14.                 Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)
    
15.                 Rng(2).Copy Rng(1).Cells(1, -3)
    
16.                 .Parent.Close False
    
17.             End With
    
18.          Next
    
19.     End With
    
20. End Sub

複製代碼

198188

回復 50# GBKEE


    Option Explicit

Sub Ex()

   Dim Rng(1 To 2) As Range
   
   
     With Workbooks("payment.XLSM").Sheets("2012")
         Sheets("2012").Range("A2:L65536").ClearContents
         Sheets("2012").Range("A2:L65536").Interior.Color = xlNone

         .Range("A1").CurrentRegion.Offset(1) = ""
         
        Set Rng(1) = .[e2]

             With Workbooks.Open("C:\Documents and Settings\USER\桌面\Connie.XLSX").Sheets("SHEET1")

             Set Rng(2) = .[A2:L2]

             Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

             Rng(2).copy Rng(1).Cells(1, -3)
            
             .Parent.Close False

         End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)
        
         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Lily.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Jane.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]
            
            Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

            Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)
        
         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Jenny.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
        
        Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(2)

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Patrick.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

           Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)

           Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

            Rng(2).copy Rng(1).Cells(1, -3)

            .Parent.Close False

        End With
End With

End Sub

經過改良後，成功了，就成效寫出來與大家分享~~

198188

回復 50# GBKEE


    原來是這樣寫Range("e" & …我就是想不通怎樣用語法表達這句話!之前還想E1000來表示，但放錯在上一句

GBKEE

回復 48# 198188
當我E欄中間有一列空白: 可由檔案底部往上

1.     Set Rng(2) = Rng(2).Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)
   
2.     Set Rng(2) = Rng(2).Resize(.Range("E" & .Rows.Count).End(xlUp).Row - 1)

複製代碼

回復 49# 198188
VBA 的說明

1. Resize 屬性
   
2. 請參閱套用至範例特定調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
   
3. expression.Resize(RowSize, ColumnSize)
   
4. expression     必選。該運算式傳回要調整大小的 Range 物件。
   
5. RowSize     選擇性的 Variant。新範圍中所包含的列數。如果省略此引數，範圍中的列數保持不變。
   
6. ColumnSize     選擇性的 Variant。新範圍中所包含的欄數。如果省略此引數，範圍中的欄數保持不變。

複製代碼

1. For xi = 1 To 5
   
2.         Set Rng(2) = Rng(2).Resize(xi)
   
3.         MsgBox Rng(2).Address
   
4.     Next

複製代碼

198188

回復 47# GBKEE


    正如第38貼Patrick.XLSX，E 欄只有幾欄資料怎會超出範圍？Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)這句以什麼作為規則？

198188

回復 47# GBKEE


   感激解釋，
但是我試過除了剛才這句 Set Rng(1) = Rng(1).End(xlDown).Offset(1)出現問題外，當我E欄中間有一列空白，就不懂往下copy，所以才用A欄，明白原理，但就是轉不過來怎樣改？

         With Workbooks.Open("C:\Documents and Settings\USER\桌面\Patrick.XLSX").Sheets("SHEET1")

            Set Rng(2) = .[A2:L2]

            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)

            Rng(2).Copy Rng(1).Cells(1, -3)

            .Parent.Close False

GBKEE

回復 46# 198188
41# 的錯誤在

1.           Set Rng(2) = .[A2:L2]
   
2.           Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))   'A欄沒資料 [A2].End(xlDown) 會到檔案底部

複製代碼

39# 已提醒你: 給你的程式碼要消化一下,VBA才會進步

1.    
   
2.           Set Rng(1) = .[E2]  'E欄資料有連續
   
3.          '
   
4.          '
   
5.            Set Rng(2) = .[A2:L2]
   
6.           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用
   
7.             Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)  
   
8.            '[E1].End(xlDown) 到E欄有資料的地方會停止,才不會到檔案底部
   
9.             Rng(2).copy Rng(1).Cells(1, -3)

複製代碼

198188

回復 44# GBKEE


    Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))
A欄第二列開始往下到最後一筆範圍的列數 ?? 如大於 65536-999 +1
********** 複製的資料範圍>貼上位置的範圍 ?? 那多出的資料要擺哪裡 ??****
或者
這句可否改成A欄第二列開始往下到最後一筆範圍的列數,但基於有時會隔開一列，可否加多句找到最後一筆的那列後加兩列，如果也沒有資料，才確認是最後一筆，否則繼續往下開始