198188

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2012-12-4 13:03 | 只看該作者

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

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

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

54^#

發表於 2012-12-9 09:12 | 只看該作者

回復 53# GBKEE

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

53^#

發表於 2012-12-9 08:07 | 只看該作者

回復 52# 198188

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

Option Explicit
Sub Ex()
Dim Rng(1 To 2) As Range, Files_AR(), E As Variant
Files_AR = Array("Connie.XLSX", "Lily.XLSX", "Jane.XLSX", "Jenny.XLSX")
'檔案名稱置入陣列:簡化程式的書寫
With Workbooks("payment.XLSM").Sheets("2012")
.Range("A2:L65536").ClearContents
.Range("A2:L65536").Interior.Color = xlNone
.Range("A1").CurrentRegion.Offset(1) = "" '清除A1連續範圍Offset(1):第一列以後連續範圍資料
For Each E In Files_AR '迴圈取同一資料夾的檔案
Set Rng(1) = .Range("E" & .Rows.Count).End(xlUp).Offset(1) 'Offset(2)=> 本身算起如是E1-> E3
With Workbooks.Open("C:\Documents and Settings\USER\桌面\" & E).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
Next
End With
End Sub

複製代碼

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

52^#

發表於 2012-12-8 21:37 | 只看該作者

回復 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

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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

51^#

發表於 2012-12-8 15:00 | 只看該作者

回復 50# GBKEE

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

50^#

發表於 2012-12-8 12:36 | 只看該作者

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

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)

複製代碼

回復 49# 198188
VBA 的說明

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

複製代碼

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

複製代碼

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

49^#

發表於 2012-12-8 11:08 | 只看該作者

回復 47# GBKEE

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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

48^#

發表於 2012-12-8 11:04 | 只看該作者

回復 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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

47^#

發表於 2012-12-8 10:44 | 只看該作者

本帖最後由 GBKEE 於 2012-12-8 10:45 編輯

回復 46# 198188
41# 的錯誤在

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

複製代碼

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

Set Rng(1) = .[E2] 'E欄資料有連續
'
'
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)
'[E1].End(xlDown) 到E欄有資料的地方會停止,才不會到檔案底部
Rng(2).copy Rng(1).Cells(1, -3)

複製代碼

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

46^#

發表於 2012-12-8 10:33 | 只看該作者

回復 44# GBKEE

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

TOP