麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 指定檔案抓去個檔案間資料 [打印本頁]

作者: ounmaxz 時間: 2011-11-22 16:58 標題: 指定檔案抓去個檔案間資料

小弟目前需整理很多人工時問題希望從[工時整理]檔內匯入
M1~M16的檔案內容排序方式為
M1檔匯至A1起始
M2檔匯至A1000起始
M3檔匯至A2000起始
一直排到M14 16000起始
各M檔內A1~AA1000 資料都須複製到工時整理]檔內
希望只要按一檔案內按鈕九可以抓取M1~M14黨內資料不需一個一個開啟
拜託各位大大幫忙

[attach]8600[/attach]

作者: ounmaxz 時間: 2011-11-23 15:36

回復 1# ounmaxz

ub 巨集1()
'
' 巨集1 巨集
'

'
Workbooks.Open Filename:="Q:\M1.xlsx"
Range("A4:X400").Select
Selection.Copy
Windows("工時整理.xlsm").Activate
Range("A3").Select
ActiveSheet.Paste
Windows("M1.xlsx").Activate
ActiveWindow.Close

Workbooks.Open Filename:="Q:\M2.xlsx"
Range("A4:W400").Select
Selection.Copy
Windows("工時整理.xlsm").Activate
Range("A400").Select
ActiveSheet.Paste
Windows("M2.xlsx").Activate
ActiveWindow.Close

小弟我用錄製的手法做出來了但是
會一直出現剪貼簿要我選擇要不要清空他
因為檔案很多一直按很麻煩有辦法解決嗎???

作者: GBKEE 時間: 2011-11-23 16:14

回復 2# ounmaxz

Sub Ex()
Dim Rng As Range, CopyRng As Range, I As Integer
Set Rng = Workbooks("工時整理.xlsm").Sheets(1).[a1]
For I = 1 To 16
With Workbooks.Open("Q:\M" & I & ".xlsx")
Set CopyRng = .Sheets(1).UsedRange.Offset(3)
Rng.Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
Set Rng = Rng.Offset(IIf(I = 1, 999, 1000))
.Close False
End With
Next
End Sub

複製代碼

作者: lilytracy 時間: 2011-11-23 18:52

範例只有14個檔案
For I = 1 To 16
應改為For I = 1 To 14

作者: GBKEE 時間: 2011-11-23 20:11

回復 4# lilytracy
樓主說的:
小弟目前需整理很多人工時問題希望從[工時整理]檔內匯入 M1~M16 的檔案內容排序方式為

作者: davidoff 時間: 2011-11-23 20:47

借此題一問
如果只要匯入M1,M2,M3到book1
且book1中，匯入的資料M1~M3間不留空白
小弟將GBKEE版主的程式改寫如下

Sub Ex()
Dim Rng As Range, CopyRng As Range, I As Integer
Set Rng = Workbooks("Book1").Sheets(1).[a65536]
For I = 1 To 3
With Workbooks.Open("C:\Users\tt\Desktop\新增資料夾\" & I & ".xls")
ActiveSheet.Range("a4", ActiveCell.SpecialCells(xlLastCell)).Copy Rng.End(xlUp).Offset(1)
.Close False
End With
Next
End Sub

複製代碼

想請教的是
一旦省略了ActiveSheet,就會出現"物件不支援此屬性或方法"
為什麼ActiveSheet一定要寫出來才能執行？
開檔案的時候，開出來的檔不是處於Activate的狀態嗎？
測試過在沒有執行開檔動作的時候，省略ActiveSheet是沒有問題的說。:Q

作者: GBKEE 時間: 2011-11-24 07:43

本帖最後由 GBKEE 於 2011-11-24 07:46 編輯

回復 6# davidoff
程式碼改寫在一般模組或ThisWorkbook模組
你的程式碼是寫在工作表物件模組
Range 沒指明工作表就是專屬於這工作表物件模組的工作表Range
你不能在其他工作表中執行這專屬於這工作表物件模組的工作表Range

作者: ounmaxz 時間: 2011-11-24 08:48

回復 3# GBKEE

感謝大大的幫忙
但是因為檔名世人名故用M1來替代
如果使用此程式會造成無法讀取資料
是否可在抓取的主檔EXCEL直接寫入路徑及檔名
再去抓取所要的資料

作者: GBKEE 時間: 2011-11-24 09:16

回復 8# ounmaxz

Option Explicit
Sub Ex()
Dim Rng As Range, NameRng As Range, CopyRng As Range, E As Range
Set NameRng = Workbooks("工時整理.xlsm").Sheets(2).[A1:A16] '人名的範圍或是完整的路徑檔案名稱
Set Rng = Workbooks("工時整理.xlsm").Sheets(1).[a1]
For Each E In NameRng
With Workbooks.Open("Q:\" & E & ".xlsx") 'E=人名
'With Workbooks.Open(E) '如 E = 完整的路徑檔案名稱
Set CopyRng = .Sheets(1).UsedRange.Offset(3)
Rng.Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
Set Rng = Rng.Offset(IIf(Rng.Row = 1, 999, 1000))
.Close False
End With
Next
End Sub

複製代碼

作者: ounmaxz 時間: 2011-11-24 09:25

回復 9# GBKEE

可指定抓取M1 A4:AD400資料
工時紀錄檔內將追隨前一筆資料中間不要留空白表格嗎???

作者: GBKEE 時間: 2011-11-24 09:37

回復 10# ounmaxz

Option Explicit
Sub Ex()
Dim Rng As Range, NameRng As Range, CopyRng As Range, E As Range
Set NameRng = Workbooks("工時整理.xlsm").Sheets(2).[A1:A16] '人名的範圍或是完整的路徑檔案名稱
Set Rng = Workbooks("工時整理.xlsm").Sheets(1).[a1]
For Each E In NameRng
With Workbooks.Open("Q:\" & E & ".xlsx") 'E=人名
'With Workbooks.Open(E) '如 E = 完整的路徑檔案名稱
Set CopyRng = .Sheets(1).UsedRange.Offset(3)
Rng.Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
If Rng.End(xlDown).Row = Rows.Count Then
Set Rng = Rng.End(xlDown).End(xlUp).Offset(1)
Else
Set Rng = Rng.End(xlDown).Offset(1)
End If
.Close False
End With
Next
End Sub

複製代碼

作者: davidoff 時間: 2011-11-24 10:06

回復 7# GBKEE
感謝GBKEE版主的回答！
看完解答再經過實作之後，
有體認到程式碼寫在一般模組、Sheet模組及ThisWorkbook模組的差異。
看來省略的寫法真的要特別注意適用的模組類型。

作者: ounmaxz 時間: 2011-11-24 11:08

回復 11# GBKEE

使用後兩種路徑選擇模式都顯示10004錯誤無法開啟檔案
目前檔案室放在網路連線的磁碟內
我使用錄製的路徑來做為索引的路徑
套用到大大的程式裡卻找不到
是我路徑選定有問題嗎

附上使用路徑
Q:\4A00維護課\內部控管\維修工時報工管理\2012年\M1.xlsx

作者: GBKEE 時間: 2011-11-24 11:36

回復 13# ounmaxz
上傳程式碼看看

作者: ounmaxz 時間: 2011-11-24 13:17

本帖最後由 ounmaxz 於 2011-11-24 13:26 編輯

回復 14# GBKEE

上傳圖片比較容易說明
請看~~

[attach]8613[/attach]
[attach]8614[/attach]

以下程式碼是我用錄製的執行上OK

Workbooks.Open Filename:="Q:\4A00維護課\內部控管\維修工時報工管理\2012年\M1.xlsx"
Range("A4:AD400").Select
Selection.Copy
Windows("123.xlsm").Activate
Range("A3").Select
ActiveSheet.Paste
Windows("M1.xlsx").Activate
ActiveWindow.Close

作者: GBKEE 時間: 2011-11-24 14:18

本帖最後由 GBKEE 於 2011-11-24 14:20 編輯

回復 15# ounmaxz
A1:A16 中如有空白當然會有錯誤
Set NameRng = Workbooks("123.xlsm").Sheets(2).[A1:A16]
改成 A1:A16 中有資料的程式碼
Set NameRng = Workbooks("123.xlsm").Sheets(2).[A1:A16].SpecialCells(xlCellTypeConstants)
A1:A16 如全部是空白(沒有資料)也是一樣會有錯誤

作者: ounmaxz 時間: 2011-11-24 14:56

回復 16# GBKEE

感謝大大不厭其煩地幫忙
目前測試已能正常運作
被路徑跟檔名套的團團轉:L

作者: ounmaxz 時間: 2011-11-25 11:16

回復 16# GBKEE

目前使用上都沒有問題
只是螢幕會一直閃一直閃
能夠在程式執行時停止更新螢幕嗎
執行完再更新螢幕
不然一直閃眼睛好痛

Sub Ex()
Dim Rng As Range, NameRng As Range, CopyRng As Range, E As Range
Set NameRng = Workbooks("工時整理.xlsm").Sheets(5).[A2:A20].SpecialCells(xlCellTypeConstants) '人名的範圍或是完整的路徑檔案名稱
Set Rng = Workbooks("工時整理.xlsm").Sheets(1).[a3]
For Each E In NameRng
      'With Workbooks.Open("Q:\" & E & ".xlsx")  'E=人名
      With Workbooks.Open(E) '如 E = 完整的路徑檔案名稱
         Set CopyRng = .Sheets(1).UsedRange.Offset(3)
         Rng.Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
         If Rng.End(xlDown).Row = Rows.Count Then
            Set Rng = Rng.End(xlDown).End(xlUp).Offset(1)
         Else
            Set Rng = Rng.End(xlDown).Offset(1)
         End If
         .Close False
      End With
Next
End Sub

作者: GBKEE 時間: 2011-11-25 12:09

回復 18# ounmaxz
程式開始時停止螢幕更新 Application.ScreenUpdating = False
程式結束前恢復螢幕更新 Application.ScreenUpdating = True

作者: ounmaxz 時間: 2011-11-25 16:30

回復 19# GBKEE

感謝GBKEE 大大的幫忙謝謝

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)