123456
返回列表 上一主題 發帖

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

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
31# 跳轉到 »
發表於 2012-12-6 15:04 | 只看該作者
回復 30# GBKEE


我的五個DATA BASE裏面都是以E欄作最後一筆資料，但之前的program好像是以A欄尋找最後一筆，對嗎？

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
32#
發表於 2012-12-6 15:34 | 只看該作者
回復 31# 198188
  1. Set Rng(2) = .[A2:AL2]
  2.     'Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))
  3.     Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  4.     'Resize 屬性 調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
複製代碼

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
33#
發表於 2012-12-6 17:02 | 只看該作者
回復 32# GBKEE

Option Explicit

Sub copy()

   Dim Rng(1 To 2) As Range

   'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012")

   With Workbooks("payment.XLSM").Sheets("2012")                     


       .Range("A1").CurrentRegion.Offset(1) = ""               




        Set Rng(1) = .[A2]                                    
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")                 
             Set Rng(2) = .[A2:AL2]                        
       Set Rng(2) = .Range(Rng(2), .[A2].End(xlDown))

  

            Rng(2).copy Rng(1)

           .Parent.Close False                                 

        End With

        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")     
           Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

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

            Rng(2).copy Rng(1)

           .Parent.Close False                                 
        End With

      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)            
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("sheet1")               
            Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

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

           .Parent.Close False                                 
        End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              

        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("sheet1")   
            
             Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

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

           .Parent.Close False                                 

        End With
      
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
        With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("sheet1")   
            
        
           Set Rng(2) = .[A2:AL2]

           Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

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

           .Parent.Close False                                 

        End With
      

    End With

End Sub

Set Rng(1) = Rng(1).End(xlDown).Offset(1)      出現ERROR :RUN-TIME ERROR '1004'; APPLICATION-DEFINED OR OBJECT-DEFINED ERROR

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
34#
發表於 2012-12-7 09:02 | 只看該作者
回復 32# GBKEE


    Set Rng(1) = Rng(1).End(xlDown).Offset(1)      出現ERROR :RUN-TIME ERROR '1004'; APPLICATION-DEFINED OR OBJECT-DEFINED ERROR
請問是哪裏有問題？

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
35#
發表於 2012-12-7 09:45 | 只看該作者
本帖最後由 GBKEE 於 2012-12-7 09:47 編輯

回復 34# 198188
修改錯誤點
  1.      If  Rng(1).End(xlDown).Row <> Rng(1).Parent.Rows.Count Then
  2.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
  3.     Else
  4.         MsgBox "已到檔案底部 無法新增資料"
  5.        Exit Sub
  6.     End If
複製代碼

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
36#
發表於 2012-12-7 10:30 | 只看該作者
回復 35# GBKEE


    這麼快到底部嗎？我的資料才幾十列？

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
37#
發表於 2012-12-7 11:21 | 只看該作者
回復 35# GBKEE


    Set Rng(1) = .[A2]
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")
              Set Rng(2) = .[A2:AL2]
       Set Rng(2) = .Range(Rng(2), .[e2].End(xlDown))

   

             Rng(2).copy Rng(1)

            .Parent.Close False

        End With

         
         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")
            Set Rng(2) = .[A2:AL2]

            Set Rng(2) = .Range(Rng(2), .[AL2].End(xlDown))

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

            Rng(2).copy Rng(1)

            .Parent.Close False
        End With
會不會因為之前是用A欄來計算最後一筆，但現在我改成用E欄檢查最後一筆，而 Set Rng(1) = Rng(1).End(xlDown).Offset(1)這句話是用A欄來設定？
Set Rng(1) = .[A2]
Set Rng(1) = Rng(1).End(xlDown).Offset(1)

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
38#
發表於 2012-12-7 13:58 | 只看該作者
回復 35# GBKEE


Option Explicit
Sub copy()
   Dim Rng(1 To 2) As Range
    'With Workbooks.Open("C:\Users\patrick.HKG\Desktop\COPY.XLSM").Sheets("2012")
    With Workbooks("payment.XLSM").Sheets("2012")                     
        .Range("A1").CurrentRegion.Offset(1) = ""               
        Set Rng(1) = .[a2]                                      
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")   
             Set Rng(2) = .[A2:L2]
             Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))     
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)               
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")     
            Set Rng(2) = .[A2:L2]
            Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
            Rng(2).copy Rng(1)
            .Parent.Close False                                   
        End With
         Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("sheet1")   
             Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.XLSX").Sheets("sheet1")                 Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                  
         End With
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)              
         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("sheet1")   
             Set Rng(2) = .[A2:L2]                          
       Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))   
            Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
             Rng(2).copy Rng(1)
            .Parent.Close False                                 
         End With
    End With
End Sub
  我用了上面的程式，但出來的result卻無法全部出來。請問哪裡需要改？

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
39#
發表於 2012-12-7 17:07 | 只看該作者
回復 38# 198188
  1. Option Explicit
  2. Sub Ex() '程序名稱不要用 copy 這是vba方法的關鍵字
  3.    Dim Rng(1 To 2) As Range
  4.      With Workbooks("payment.XLSM").Sheets("2012")
  5.          .Range("A1").CurrentRegion.Offset(1) = ""
  6.         Set Rng(1) = .[E2]  'E欄資料有連續
  7.        'MsgBox Rng(1).Cells(1, -3).Address '回到A欄
  8.          With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")
  9.              Set Rng(2) = .[A2:L2]
  10.              Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  11.              Rng(2).copy Rng(1).Cells(1, -3)   'A欄
  12.             .Parent.Close False
  13.          End With
  14.         Set Rng(1) = Rng(1).End(xlDown).Offset(1)
  15.          With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")
  16.             Set Rng(2) = .[A2:L2]
  17.            ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用
  18.             Set Rng(2) = Rng(2).Resize(.[E1].End(xlDown).Row - 1)
  19.             Rng(2).copy Rng(1).Cells(1, -3)
  20.             .Parent.Close False
  21.         End With
  22.         '
  23.         '
  24.         ' 以下同
  25.         '
  26.         '
  27.         

  29.       End With
  30. End Sub
複製代碼

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
40#
發表於 2012-12-7 17:35 | 只看該作者
回復 39# GBKEE


    Option Explicit

Sub Ex() '程序名稱不要用 copy 這是vba方法的關鍵字


   Dim Rng(1 To 2) As Range

     With Workbooks("payment.XLSM").Sheets("2012")

         .Range("A1").CurrentRegion.Offset(1) = ""

        Set Rng(1) = .[E2]  'E欄資料有連續

       'MsgBox Rng(1).Cells(1, -3).Address '回到A欄

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Connie.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)   'A欄

            .Parent.Close False

         End With

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

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Lily.XLSX").Sheets("SHEET1")

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

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

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

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

            .Parent.Close False

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

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jane.XLSX").Sheets("SHEET1")

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

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

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

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

            .Parent.Close False

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

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Jenny.XLSX").Sheets("SHEET1")

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

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

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

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

            .Parent.Close False

        End With
        
        Set Rng(1) = Rng(1).End(xlDown).Offset(1)     '程式run 到這裡出現問題 application-defined or object-defined error

         With Workbooks.Open("C:\Users\patrick.HKG\Desktop\Patrick.XLSX").Sheets("SHEET1")

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

           ' **** Set Rng(2) = .Range(Rng(2), .[a2].End(xlDown))  ***** 這行不要用

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

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

            .Parent.Close False

        End With
End With

End Sub
最後一個出現問題
   Set Rng(1) = Rng(1).End(xlDown).Offset(1)     '程式run 到這裡出現問題 application-defined or object-defined error
另外中間有一列空格，之後的資料就無法出來。但第一次的程式，在copy 第一個excel 就算中間有一列空格，它也可以往下copy?

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
123456
返回列表 上一主題