VBA 異なるブック間で変更のあった複数行をコピペするマクロの一部です。

Question

VBA初心者が身の程をわきまえずに、大作にいどまざるを得なくなり大苦戦しております。
どうか助けてください。　
下記のステップ③の部分をなんとか考えてみましたがお手上げです。
Application.EnableEventsで囲うのもあっているのかどうか・・・

①集約用のエクセルを用意（ブックＡとします）
②編集用のエクセルを用意（ブックＢとします）
③編集者は編集用エクセルを編集（手動）
ＣＨＡＮＧＥにて変更があった箇所を表示（マクロ)

Sub Book_Data_Copy()

Dim wb_A As Workbook, wb_B As Workbook
Dim ws_A_Pasteto As Worksheet, ws_B_Copyfm As Worksheet

Dim i As Integer 'Ａから値を見つける行カウンタ
Dim fcell As Object '見つかったオブジェクト
Dim Key As String '検索する値
Dim frow As Integer '見つかった行番号

i = 1

Set wb_A = ThisWorkbook
Set wb_B = Workbooks.Open("C:\Users\XXXXX\Desktop\Sample2.xlsm")

Private Sub Worksheet_Change(ByVal Target As Range)

'③変更フラグと記載フラグの処理
'AH4からAK379 4行目から379行目まで34列目から37列目までという条件

Application.EnableEvents = False

If (Target.Row >= 4 And Target.Row <= 379) And (Target.Column >= 34 And _
Target.Column <= 37) Then

'AAA列に8を書き出す

Range("AAA" & Target.Row).Value = 8

End If

Application.EnableEvents = True

なにとぞよろしくお願いします。

プログラマーもっくん · Accepted Answer

とりあえずわからないので。

　フラグは付けず、ＡとＢを比較し違うもののみＡへ転記します。

Sub Book_Data_Copy()

'変更フラグと記載フラグの処理はありません。
'全データを探し、ＡのＤ列の値がＢにあればＢからＡへ値を転記します。
'重複データがあった場合は上書きをされます。

Dim wb_A As Workbook, wb_B As Workbook
Dim ws_A_Pasteto As Worksheet, ws_B_Copyfm As Worksheet
Dim i As Integer 'Ａから値を見つける行カウンタ
Dim fcell As Object '見つかったオブジェクト
Dim Key As String '検索する値
Dim frow As Integer '見つかった行番号

i = 1

Set wb_A = ThisWorkbook
Set wb_B = Workbooks.Open("C:\Users\motoki\Desktop\Sample2.xlsm")

Set ws_A_Pasteto = wb_A.Worksheets("Bdata")
Set ws_B_Copyfm = wb_B.Worksheets("Bdata")

'ＡのＤ列の値をＢから検索（完全一致）
Do While ws_A_Pasteto.Cells(i, "D") <> ""

Key = ws_A_Pasteto.Cells(i, "D")
With ws_B_Copyfm.Columns("D")
Set fcell = .Find(What:=Key, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not fcell Is Nothing Then
frow = fcell.Row

If ws_A_Pasteto.Range("AH" & i) <> ws_B_Copyfm.Range("AH" & frow) Or ws_A_Pasteto.Range("AI" & i) <> ws_B_Copyfm.Range("AI" & frow) Or _
ws_A_Pasteto.Range("AJ" & i) <> ws_B_Copyfm.Range("AJ" & frow) Or ws_A_Pasteto.Range("AK" & i) <> ws_B_Copyfm.Range("AK" & frow) Then

ws_A_Pasteto.Range("AH" & i & ":" & "AK" & i).Value = ws_B_Copyfm.Range("AH" & frow & ":" & "AK" & frow).Value 'ＢのＡＨ→ＡのＡＨへ値をコピー

End If
End If
End With

i = i + 1
Loop

wb_B.Close

Set wb_A = Nothing
Set wb_B = Nothing

Set ws_A_Pasteto = Nothing
Set ws_B_Copyfm = Nothing

End Sub

fujillin · Answer

ANo3です。

＞実はブックBは、複数存在し、B1, B2, B3・・・
＞複数の人が作業し、担当する行だけ編集後にブックAにまとめる
そのような場合は、ご質問のように単純にコピペするマクロでは上手くいかない可能性がありそうです。
担当する部分が決まっているなら、まず、担当外の範囲はブックAには反映しないようにしておく方がよさそうに思います。なぜなら謝って変更しても担当外なので気付きにくいと想像しますし、それもそのまま反映されてしまうことになります。

更には、ブックBの担当外のデータは、ブックAが更新されても古いままということになりますよね？
関係ないので古くても問題がないというのであれば、初めから担当外のデータは表示せずに、必要な部分だけの入力ができるような設計にしておく方が良さそうな気がします。
あるいは、シートの保護などを利用して、あらかじめ変更可能なセルをそれぞれに限定しておくといったことも考えられます。

また、複数の人が作業をする場合は、ブックAへの書き込みが同時に発生する可能性があるということなので、これに対する配慮も必要になると思われます。
起こる確率は少ないかも知れませんが、エラーで止まってしまった時に、皆が適切な対処がとれるとは限りませんので。

全体がよくわからないのでなんとも言えませんが、補足と併せて考えると・・
・各担当がキチンと分かれているのなら、ブックAを開く時にそれぞれのブックBからデータを読み込むマクロを設定しておくだけでも事足りるように思います。でも、値の参照だけなので、マクロにしなくても参照式を設定しておけば済みそうですね。
・担当に重複があって、変更の最新情報を即時に反映しなければならないということだとすると、上記では上手くいきませんね。

私は使ったことがないので詳しくありませんが、複数の人が編集可能で最新情報を維持するという目的で、エクセルには「共有」という機能があるようです。
この機能を上手く使えれば、マクロや参照式も必要なくなるかも知れませんので、一度調べてみてはいかがでしょうか。

fujillin · Answer

こんにちは

よくわからないのですが、ご提示のコードではなく、質問のタイトルから類推すると、ブック Bは編集(入力)専用にしておいて、最終的には、ブックBのAH4:AK379の内容をブック Aに常に反映しておきたいということなのでしょうか？

もしそうであるなら、変更個所や差分などを調べなくとも、常に全体が反映されるようにしておけば良いように思います。

マクロで処理するなら、(例えば)ブックB保存時に範囲全体をコピペするとかでも済みそうです。
ブックAの関数式で、対称範囲を参照するように設定しておくのもありかもしれません。

よくわかっておらずに回答していますので、的外れでしたら、スルーしてください。

プログラマーもっくん · Answer

お疲れ様です。

以前、別件で回答させて頂きました。

③は編集用のエクセルに記載する予定でしょうか？

それとも、集約用と編集用を比較させて違った場合に集約用にコピーするのでしょうか？

VBA 異なるブック間で変更のあった複数行をコピペするマクロの一部です。

ANo3です。

こんにちは

とりあえずわからないので。

お疲れ様です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング