返回列表 上一主題 發帖

[發問] 利用一個巨集,複製A檔案到B檔案問題

[發問] 利用一個巨集,複製A檔案到B檔案問題

爬了一下先前的文章,也去YouTube看了一些複製的教學影片
都是看到同個EXCEL複製到不同的資料表
沒看到類似的應用 ,不知道如何利用一個檔案假設是C檔案
去搜尋A檔案某欄位與B檔案某欄位,一樣的 複製去B檔案
A檔案檔名oldB檔案檔名FMC
發問.png
2015-10-24 11:02


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

欄位都從第7行開始 B7 C7 D7 F7 G7

回復 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
複製代碼

TOP

本帖最後由 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
複製代碼

TOP

回復 3# lpk187


    感謝大大的指點!以及詳細的註解!
自己爬的文都是使用Range(欄位).select         Range(欄位).copy    Activesheet.Paste 的方式~
又多學了一招

TOP

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

TOP

回復 5# blunt


    FMC是我自己設的資料表名稱拉~~~~那行的意思應該是打開A檔案的"FMC"資料表
如果你資料表示預設的應該就是sheet1

TOP

回復 3# lpk187

請問一下VBA有辦法做到貼上保留來源格式嗎?(來源欄寬、高)

TOP

本帖最後由 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 說明
不過,我覺得 單一儲存格複製欄高列寛的,好像沒什麼意義! 前面的儲存格一定會被後面的修改掉的

TOP

回復 8# lpk187


    感謝大大的提供...實際Run過之後才真的感覺沒什麼意義...
真不好意思!也讓我多學到一課!

TOP

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

回復 8# lpk187


    請問一下大大...最近又拿起這個巨集自己修改一下..
將別樣資訊帶入報表中~只是有一個疑問是成功複製過去了...但如何讓他指定去 R S T U 欄位呢
目前執行後 會再J欄旁邊K欄位依序往右邊存放
R.jpg
2015-12-13 00:40

C.jpg
2015-12-13 00:51

A檔案內容如下圖~~~
BD.jpg
2015-12-13 00:53
  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
複製代碼
請問大大如何修改呢?

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題