返回列表 上一主題 發帖

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

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

本帖最後由 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

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題