二つの条件が合致するセル入力の処理速度を早くしたい（VBA）

https://oshiete.goo.ne.jp/qa/10791019.html
上記で質問させて頂いたものです。
御教示頂きました内容で意図する動作が出来ていますが、データ数が多い（10000件ぐらい）と
スクリーンの更新等をOFFにしていても5分以上処理に時間が掛かってしまいます。
上記ご教示頂きました構文より処理速度を上げるような構文があればご教示お願い致します。

尚、時々反映されないデータがある原因が分かりましたので補足で下記します。
日付の個所でセルの表示幅が足りない時に「###」となりますが、その状態だと条件が一致した
とみなさない事が原因でした。（FIND）
セル幅を調整して日付が表示された後だと処理される事が確認出来ました。

No.4 ベストアンサー 回答者： tom04 回答日時： 2018/12/12 18:11

No.1・3です。

＞それが例えば12行目が日付で13行目以降がデータになっていた場合）

というコトなので、前回のコードに少し手を加えてみました。
「★」の行が変わっているところです。
（「反映DATA」シートのAI13セル以降は消去せず、そのまま残しています。）

Sub Sample3()
　Dim i As Long, j As Long, k As Long, L As Long
　Dim lastRow1 As Long, lastRow2 As Long, lastCol1 As Long, lastCol2 As Long
　Dim wS As Worksheet
　Dim myR1, myR2

　　Set wS = Worksheets("元DATA")
　　　lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　lastCol2 = wS.Cells(1, Columns.Count).End(xlToLeft).Column
　　　　myR2 = Range(wS.Cells(1, "A"), wS.Cells(lastRow2, lastCol2))
　　　　　With Worksheets("反映DATA")
　　　　　　lastRow1 = .Cells(Rows.Count, "C").End(xlUp).Row
　　　　　　lastCol1 = .Cells(12, Columns.Count).End(xlToLeft).Column '//★//
　　　　　　　'//「反映DATA」シートのA列12行目～最終行・最終列を配列「myR1」に！//★
　　　　　　　myR1 = Range(.Cells(12, "A"), .Cells(lastRow1, lastCol1)) '//★//
　　　　　　　　For i = 2 To UBound(myR1, 1) '//「反映DATA」シートの13行目～最終行まで//★
　　　　　　　　　For k = 2 To UBound(myR2, 1) '//「元DATA」シートの2行目～最終行まで//
　　　　　　　　　　If myR2(k, 1) = myR1(i, 3) Then '//「元データ」シートk行目が「反映」シートのi行目と等しければ・・・//
　　　　　　　　　　　For j = 35 To lastCol1 '//「反映DATA」シートのAI列～最終列まで//
　　　　　　　　　　　　For L = 4 To lastCol2 '//「元DATA」シートのD列～最終列まで//
　　　　　　　　　　　　　If myR2(1, L) = myR1(1, j) Then '//両配列の日付が等しければ・・・//
　　　　　　　　　　　　　　If myR2(k, L) <> "" Then '//「元DATA」シートのk行目・L列目が空白以外の場合は・・・//
　　　　　　　　　　　　　　　myR1(i, j) = myR2(k, L) '//配列「myR1」のi行・j列目に配列「myR2」のk行・L列目を代入//
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　End If
　　　　　　　　　　　　Next L
　　　　　　　　　　　Next j
　　　　　　　　　　End If
　　　　　　　　　Next k
　　　　　　　　Next i
　　　　　　　'//「反映DATA」シートのA12セル～最終行・最終列に一気にmyR1の値を吐き出す//★
　　　　　　　Range(.Cells(12, "A"), .Cells(lastRow1, lastCol1)) = myR1 '★
　　　　　End With
　　　　MsgBox "完了"
End Sub

※　ワークシート上でループさせるより、対象範囲を一旦配列に格納しその中でループさせる方が
各段に速いので、それぞれのシートの範囲を配列に格納しています。

myR2　→　「元DATA」シートのA1～A列最終行、1行目最終列まで
myR1　→　「反映DATA」シートのA12～C列最終行、12行目最終列まで

すなわち両配列の1行目は「日付」の行になり、
＞For i = 2 To UBound(myR1, 1)
で配列の2行目以降～最終行まで、というコトになります。
今回の場合、配列「myR1」の2行目は「反映DATA」シートの13行目に当たります。

こんな感じで理解いただけたでしょうかね？m(_ _)m

この回答へのお礼

ありがとうございました。
分かりやすくご説明頂き理解する事出来ました。
大変助かりました。

お礼日時：2018/12/14 09:34

No.3 回答者： tom04 回答日時： 2018/12/10 23:08

No.1です。

前回の質問をよく読み返してみると、更新セル？は「太字」にしていますね。
No.1で記載したように値だけの操作なので書式までは考慮していませんでした。

条件付き書式を併用してみてはどうでしょうか？
マクロを実行する前に、「反映DATA」シートを一旦別シートにコピー＆ペーストし
変化したセルだけを「太字」の設定をします。

「反映DATA」シート全体に条件付き書式を設定しても良いのですが、他のセル（名前が増えたり、日付が変わったり・・・）
などがあるとそのセルも対象になってしまいますので、
「反映DATA」シートのAI8セル以降データ対象セルを範囲指定　→　条件付き書式　→　新しいルール　→　数式を使用して・・・　→　数式欄に
=AI8<>Sheet3!AI8
という数式を入れ　→　書式から「太字」を選択しOK！

シート見出し上に使っていないSheet（Sheet3）が存在するとして、
「反映DATA」シートをすべてコピー＆ペーストします。

前回のコードの
＞'//「反映DATA」シートの8行目以降を一旦消去//
＞Range(.Cells(8, "AI"), .Cells(lastRow1, lastCol1)).ClearContents
の2行を消去し

＞With Worksheets("反映DATA")
の行の次に
＞.Cells.Copy Worksheets("Sheet3").Range("A1")

を追加してみてください。

これでAI8セル以降、更新されたセルだけが「太字」になると思います。m(_ _)m

この回答へのお礼

ありがとうございます。
問題無く太字にすることが出来ました。
今後VBAで書式を変えたい場合、条件付き書式も取り入れていきたいと思います。

お礼日時：2018/12/12 10:37

No.2 回答者： ママチャリ 回答日時： 2018/12/10 21:28

「統合」という機能をご存知ですか？統合を使えば、ごりごりループさせなくてもお望みの結果がでます。

ただ、どれくらいの性能が出るかは分からないので、一度、手操作でやって、時間を計ってみてください。いい成績が出るようであれば、それをマクロ化しましょう。頑張ってくださいね。

この回答へのお礼

統合という機能は初めて知りました。
参考にさせて頂きます。

お礼日時：2018/12/12 10:22

No.1 回答者： tom04 回答日時： 2018/12/10 21:04

こんばんは！

前回回答した者です。

＞データ数が多い（10000件ぐらい）・・・

となると、単純にループさせると相当時間がかかりますね。（応答なし）になると思います。
別の方法として、両シートを配列に格納し、その中でくるくるループさせてみてはどうでしょうか？

標準モジュールです。

Sub Sample2()
　Dim i As Long, j As Long, k As Long, L As Long
　Dim lastRow1 As Long, lastRow2 As Long, lastCol1 As Long, lastCol2 As Long
　Dim wS As Worksheet
　Dim myR1, myR2

　　Set wS = Worksheets("元DATA")
　　　lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　lastCol2 = wS.Cells(1, Columns.Count).End(xlToLeft).Column
　　　'//「元DATA」シートのA1セル～最終行・最終列を配列「myR2」に！//
　　　　myR2 = Range(wS.Cells(1, "A"), wS.Cells(lastRow2, lastCol2))
　　　　With Worksheets("反映DATA")
　　　　　lastRow1 = .Cells(Rows.Count, "C").End(xlUp).Row
　　　　　lastCol1 = .Cells(7, Columns.Count).End(xlToLeft).Column
　　　　　'//「反映DATA」シートの8行目以降を一旦消去//
　　　　　　Range(.Cells(8, "AI"), .Cells(lastRow1, lastCol1)).ClearContents
　　　　　'//「反映DATA」シートのA列7行目～最終行・最終列を配列「myR1」に！//
　　　　　　myR1 = Range(.Cells(7, "A"), .Cells(lastRow1, lastCol1))
　　　　　　　For i = 2 To UBound(myR1, 1) '//「反映DATA」シートの8行目～最終行まで//
　　　　　　　　For k = 2 To UBound(myR2, 1) '//「元DATA」シートの2行目～最終行まで//
　　　　　　　　　If myR2(k, 1) = myR1(i, 3) Then '//「元データ」シートk行目が「反映」シートのi行目と等しければ・・・//
　　　　　　　　　　For j = 35 To lastCol1 '//「反映DATA」シートのAI列～最終列まで//
　　　　　　　　　　　For L = 4 To lastCol2 '//「元DATA」シートのD列～最終列まで//
　　　　　　　　　　　　If myR2(1, L) = myR1(1, j) Then '//両配列の日付が等しければ・・・//
　　　　　　　　　　　　　If myR2(k, L) <> "" Then '//「元DATA」シートのk行目・L列目が空白以外の場合は・・・//
　　　　　　　　　　　　　　myR1(i, j) = myR2(k, L) '//配列「myR1」のi行・j列目に配列「myR2」のk行・L列目を代入//
　　　　　　　　　　　　　End If
　　　　　　　　　　　　End If
　　　　　　　　　　　Next L
　　　　　　　　　　Next j
　　　　　　　　　End If
　　　　　　　　Next k
　　　　　　　Next i
　　　　　　'//「反映DATA」シートのA7セル～最終行・最終列に一気にmyR1の値を吐き出す//
　　　　　　　Range(.Cells(7, "A"), .Cells(lastRow1, lastCol1)) = myR1
　　　　End With
　　　MsgBox "完了"
End Sub

※　マクロを実行するたびに、元データは消去するようにしています。
残したい場合は
＞'//「反映DATA」シートの8行目以降を一旦消去//
Range(.Cells(8, "AI"), .Cells(lastRow1, lastCol1)).ClearContents
の2行を消してください。

※　速度重視のため
値だけの操作になりますので、書式はお望み通りにならないと思います。m(_ _)m

この回答へのお礼

ありがとうございます。
一瞬で処理する事が出来ました。
ひとつお聞きしたいのですが、反映データの行番号が変わった場合はどこを触れば良いでしょうか？
（現状7行目が日付で8行目以降がデータとなっていますが、それが例えば12行目が日付で13行目以降がデータになっていた場合）

lastCol1 = .Cells(7, Columns.Count).End(xlToLeft).Column←７を12に変更
Range(.Cells(8, "AI"), .Cells(lastRow1, lastCol1)).ClearContents←8を13に変更
myR1 = Range(.Cells(7, "A"), .Cells(lastRow1, lastCol1))←7を12に変更
For i = 2 To UBound(myR1, 1) '//「反映DATA」シートの8行目～最終行まで//←これがなぜ8行目を指示しているのかが分かりませんでした。

お礼日時：2018/12/12 09:43