198188

回復 50# GBKEE


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

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

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

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

回復 53# GBKEE


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