返回列表 上一主題 發帖

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

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-10-24 11:08 | 只看該作者

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

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


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

欄位都從第7行開始 B7 C7 D7 F7 G7
收藏 分享

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 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
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 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
複製代碼

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
4#
發表於 2015-10-25 01:16 | 只看該作者
回復 3# lpk187


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

TOP

blunt

帖子
4 
主題
0 
精華
0 
積分
12 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2017-5-14 
5#
發表於 2015-10-25 23:21 | 只看該作者
lpk版主您好,
code裡"設定ASh是A檔案的FMC工作表物件"
可以請問FMC是甚麼嗎?
google以後發現找不到相關資訊,
麻煩指導,謝謝!!

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
6#
發表於 2015-10-25 23:26 | 只看該作者
回復 5# blunt


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

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
7#
發表於 2015-10-26 08:43 | 只看該作者
回復 3# lpk187

請問一下VBA有辦法做到貼上保留來源格式嗎？（來源欄寬、高）

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 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 說明
不過，我覺得 單一儲存格複製欄高列寛的，好像沒什麼意義！ 前面的儲存格一定會被後面的修改掉的

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
9#
發表於 2015-10-26 23:04 | 只看該作者
回復 8# lpk187


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

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
10#
發表於 2015-12-13 00:41 | 只看該作者
本帖最後由 v03586 於 2015-12-13 00:53 編輯

回復 8# lpk187


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


A檔案內容如下圖~~~
  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

        靜思自在 : 世上有兩件事不能等：一、孝順 二、行善。
返回列表 上一主題