Board logo

標題: [發問] 利用一個巨集，複製A檔案到B檔案問題 [打印本頁]
作者: v03586    時間: 2015-10-24 11:08     標題: 利用一個巨集，複製A檔案到B檔案問題

爬了一下先前的文章，也去YouTube看了一些複製的教學影片
都是看到同個EXCEL複製到不同的資料表
沒看到類似的應用 ，不知道如何利用一個檔案假設是C檔案
去搜尋A檔案某欄位與B檔案某欄位，一樣的 複製去B檔案
A檔案檔名old ，B檔案檔名FMC
[attach]22239[/attach]

如圖....如果A檔案B欄位等於B檔案B欄位
則將A檔案的C、D、F、G欄位複製到B檔案的C、D、F、G欄位

欄位都從第7行開始 B7 C7 D7 F7 G7
作者: lpk187    時間: 2015-10-24 12:13

回復 1# v03586
  1. '假設A檔案為程式所在檔
  2. Public Sub ex()
  3.     Dim Bk As Workbook, ASh As Worksheet
  4.     Dim ARng As Range, BRng As Range
  5.     mPath = ThisWorkbook.Path & "\" '設定路徑為和A檔案同路徑
  6.     mData = "B檔案.xlsx" '設定B檔案的完整名稱
  7.     Set ASh = ThisWorkbook.Worksheets("FMC") '設定ASh是A檔案的FMC工作表物件
  8.     Set Bk = Workbooks.Open(mPath & mData) '設定BK是B檔案物件，及打開B檔案。在這前提下B檔案必須是關閉的情況下，若已經打B開檔案會出錯，請關B閉檔案
  9.     With Bk.Sheets("FMC") '將在B檔案的FMC工作表執行一系列的陳述式，假設"FMC"為工作表名
  10.         For Each ARng In ASh.Range("B7:B" & ASh.Cells(65535, 2).End(xlUp).Row) 'ARng為A檔案.Worksheets("FMC")的B欄
  11.             For Each BRng In .Range("B7:B" & .Cells(65535, 2).End(xlUp).Row) ''BRng為B檔案.Worksheets("FMC")的B欄
  12.                 If ARng.Value = BRng.Value Then
  13.                     BRng.Offset(, 1) = ARng.Offset(, 1) 'C欄
  14.                     BRng.Offset(, 2) = ARng.Offset(, 2) 'D欄
  15.                     BRng.Offset(, 4) = ARng.Offset(, 4) 'F欄
  16.                     BRng.Offset(, 5) = ARng.Offset(, 5) 'G欄
  17.                 End If
  18.             Next
  19.         Next
  20.         Bk.Close True '關閉B檔案
  21.     End With
  22. End Sub
複製代碼
作者: lpk187    時間: 2015-10-24 12:32

本帖最後由 lpk187 於 2015-10-24 12:34 編輯

回復 1# v03586


    剛沒看到C檔案為VBA程式所在檔 再資修改如下：
  1. Public Sub ex()
  2.     Dim bSh As Worksheet, aSh As Worksheet
  3.     Dim ARng As Range, BRng As Range
  4.     mPath = ThisWorkbook.Path & "\" '設定路徑為和C檔案同路徑
  5.     bData = "B檔案.xlsx" '設定B檔案的完整名稱
  6.     aData = "A檔案.xlsx" '設定A檔案的完整名稱
  7.     Set aSh = Workbooks.Open(mPath & aData).Worksheets("FMC") '設定aSh是A檔案的FMC工作表物件,打開A檔案
  8.     Set bSh = Workbooks.Open(mPath & bData).Worksheets("FMC") '設定bSh是B檔案的FMC工作表物件,打開B檔案
  9.         For Each ARng In aSh.Range("B7:B" & aSh.Cells(65535, 2).End(xlUp).Row) 'ARng為A檔案.Worksheets("FMC")的B欄
  10.             For Each BRng In bSh.Range("B7:B" & bSh.Cells(65535, 2).End(xlUp).Row) ''BRng為B檔案.Worksheets("FMC")的B欄
  11.                 If ARng.Value = BRng.Value Then
  12.                     BRng.Offset(, 1) = ARng.Offset(, 1) 'C欄
  13.                     BRng.Offset(, 2) = ARng.Offset(, 2) 'D欄
  14.                     BRng.Offset(, 4) = ARng.Offset(, 4) 'F欄
  15.                     BRng.Offset(, 5) = ARng.Offset(, 5) 'G欄
  16.                 End If
  17.             Next
  18.         Next
  19.         Workbooks(bData).Close True '關閉B檔案
  20.         Workbooks(aData).Close True '關閉A檔案
  21. End Sub
複製代碼
作者: v03586    時間: 2015-10-25 01:16

回復 3# lpk187


    感謝大大的指點！以及詳細的註解！
自己爬的文都是使用Range(欄位).select         Range(欄位).copy    Activesheet.Paste 的方式~
又多學了一招
作者: blunt    時間: 2015-10-25 23:21

lpk版主您好,
code裡"設定ASh是A檔案的FMC工作表物件"
可以請問FMC是甚麼嗎?
google以後發現找不到相關資訊,
麻煩指導,謝謝!!
作者: v03586    時間: 2015-10-25 23:26

回復 5# blunt


    FMC是我自己設的資料表名稱拉~~~~那行的意思應該是打開A檔案的"FMC"資料表
如果你資料表示預設的應該就是sheet1
作者: v03586    時間: 2015-10-26 08:43

回復 3# lpk187

請問一下VBA有辦法做到貼上保留來源格式嗎？（來源欄寬、高）
作者: lpk187    時間: 2015-10-26 09:34

本帖最後由 lpk187 於 2015-10-26 09:42 編輯

回復 7# v03586


    Dim ARng As Range, BRng As Range 這裡已經宣告為Range物件
所以可以把此物件的屬性拿出來用所以只要把
BRng.Offset(, 1) = ARng.Offset(, 1) 'C欄
BRng.Offset(, 2) = ARng.Offset(, 2) 'D欄
BRng.Offset(, 4) = ARng.Offset(, 4) 'F欄
BRng.Offset(, 5) = ARng.Offset(, 5) 'G欄
改成
  1.                     With BRng.Offset(, 1)
  2.                         .Value = ARng.Offset(, 1) 'C欄
  3.                         .ColumnWidth = ARng.Offset(, 1).ColumnWidth
  4.                         .RowHeight = ARng.Offset(, 1).RowHeight
  5.                     End With
  6.                     With BRng.Offset(, 2)
  7.                         .Value = ARng.Offset(, 2) 'D欄
  8.                         .ColumnWidth = ARng.Offset(, 2).ColumnWidth
  9.                     End With
  10.                     With BRng.Offset(, 4)
  11.                         .Value = ARng.Offset(, 4) 'F欄
  12.                         .ColumnWidth = ARng.Offset(, 4).ColumnWidth
  13.                     End With
  14.                     With BRng.Offset(, 5)
  15.                         .Value = ARng.Offset(, 5) 'G欄
  16.                         .ColumnWidth = ARng.Offset(, 5).ColumnWidth
  17.                     End With
複製代碼
就可以。
詳細的屬性請自行參考VBE的Range 說明
不過，我覺得 單一儲存格複製欄高列寛的，好像沒什麼意義！ 前面的儲存格一定會被後面的修改掉的
作者: v03586    時間: 2015-10-26 23:04

回復 8# lpk187


    感謝大大的提供...實際Run過之後才真的感覺沒什麼意義...
真不好意思！也讓我多學到一課！
作者: v03586    時間: 2015-12-13 00:41

本帖最後由 v03586 於 2015-12-13 00:53 編輯

回復 8# lpk187


    請問一下大大...最近又拿起這個巨集自己修改一下..
將別樣資訊帶入報表中~只是有一個疑問是成功複製過去了...但如何讓他指定去 R S T U 欄位呢
目前執行後 會再J欄旁邊K欄位依序往右邊存放
[attach]22814[/attach]
[attach]22815[/attach]
A檔案內容如下圖~~~
[attach]22816[/attach]
  1. Public Sub ex()
  2.     Dim bSh As Worksheet, aSh As Worksheet
  3.     Dim ARng As Range, BRng As Range
  4.     mPath = ThisWorkbook.Path & "\" '設定路徑為和C檔案同路徑
  5.     bData = "FMC.xls" '設定B檔案的完整名稱(報表)
  6.     aData = "吸嘴Table.xls" '設定A檔案的完整名稱(Table)
  7.     Set aSh = Workbooks.Open(mPath & aData).Worksheets("Rubber Tip") '設定aSh是A檔案的FMC工作表物件,打開A檔案(Table)
  8.     Set bSh = Workbooks.Open(mPath & bData).Worksheets("FMC") '設定bSh是B檔案的FMC工作表物件,打開B檔案(報表)
  9.         For Each ARng In aSh.Range("A2:A" & aSh.Cells(65535, 2).End(xlUp).Row) 'ARng為A檔案.Worksheets("FMC")的B欄(Table)
  10.             For Each BRng In bSh.Range("J7:J" & bSh.Cells(65535, 2).End(xlUp).Row) ''BRng為B檔案.Worksheets("FMC")的B欄(報表)
  11.                 If ARng.Value = BRng.Value Then
  12.                     BRng.Offset(, 1) = ARng.Offset(, 1) 'B欄
  13.                     BRng.Offset(, 2) = ARng.Offset(, 2) 'C欄
  14.                     BRng.Offset(, 3) = ARng.Offset(, 3) 'D欄
  15.                     BRng.Offset(, 4) = ARng.Offset(, 4) 'E欄
  16.                 End If
  17.             Next
  18.         Next
  19. '        Workbooks(bData).Close True '關閉B檔案
  20.         Workbooks(aData).Close True '關閉A檔案
  21. End Sub
複製代碼
請問大大如何修改呢?



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