ループ処理が遅いので配列化に出来ないでしょうか？

Question

セル通しを比較して下記のような処理を行っています。
セルの値を書き換えているので遅くなっているので
配列で処理する方法はないでしょうか？

上画像が現データ　下画像がやりたい事です。
基準２行目のＡ列からＧ列と３行目のＡ列からＧ列を順番に比較し不一致だったらセル値を右へ一つ移動する。
基準２行目のＡ列からＧ列と４行目**のＡ列からＧ列を順番に比較し不一致だったらセル値を右へ一つ移動する。

Sub test()
Dim ws As Worksheet
Set ws = Sheets("test1")

Dim last_row, x, y As Long
last_row = ws.Cells(Rows.Count, 1).End(xlUp).Row
x = 3
y = 4

Dim base_str, search_str As String

Do While y <= last_row
     For x = 3 To 17
        base_str = Cells(2, x)
        search_str = Cells(y, x)
            If InStr(search_str, base_str) = 0 Then
                Range(ws.Cells(y, x), ws.Cells(y, 17)).Offset(0, 1).Value _
               = Range(ws.Cells(y, x), ws.Cells(y, 17)).Value
               ws.Cells(y, x).Value = ""
            End If
    Next x
    y = y + 1
Loop

End Sub

よろしくお願いいたします。

Comments

[Matsumon0104]

「セル通しを比較して下記のような処理」の内容を詳しく記載いただけますでしょうか？
before, afterのような記載が見られますが、同じデータのようで、どんな処理結果を望んでいるのかわかりません。

掲載いただいたソースを確認すれば、どういった処理をしたいのかが見えてくるとは思うのですが、わざわざプログラムの処理を回答者側で追わないと質疑内容がわからないとなると、回答もつきにくいかと思います。

[sankichi4301]

イメージを画像に変更させていただきました。

[okakemetal]

A列からG列の最終業までを範囲指定して、２次元配列Aへ格納
同様に、I列からO列の最終行までを範囲指定して、２次元配列Bへ格納
ループ１で行数のカウンタ、ループ２で列数のカウンタをまわして
配列Aと配列Bを比較して・・・・

比較結果を最終的にどうしたいのか読み取れませんでしたので、ここまで

[sankichi4301]

早速の返事ありがとうございます。

再度イメージを画像に変更させていただきました。
画像したにやりたい内容を追記しました。

[sankichi4301]

全ては載せられなかったので、一部分を載せました。
＞１．ソースをみると、For x = 3 To 17になっていて、C列からP列が対象になっています。
現状はC列からP列なのですが、A列からP列をまで行いたいです。

＞２．ソースをみると、比較を開始する行は４行目からになっています。
３行目も比較します。

＞３．セルを比較するときに、InStrを使用しています。
①search_strの文字列内にbase_str の文字列が含まれないならセルを右へ移動する。　です。

[sankichi4301]

shiketaさんへ　
回答ありがとうございます。
記載していないだけで、画像更新停止処理は行っています。

[sankichi4301]

hatena19
回答ありがとうござます。
やりたいことができ、速度も体感で10の１になりました。
末端からループの使い方も勉強になりました。

Answer 1

ループ処理実行中は、画面を更新しない、とか。

• https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.screenupdating

マクロの速度を向上させるため、画面を更新しないようにします。 この場合、マクロの処理過程は見ることができませんが、実行速度が速くなります。

Answer 2

補足要求です。

基準２行目のＡ列からＧ列と３行目のＡ列からＧ列を順番に比較し不一致だったらセル値を右へ一つ移動する。
基準２行目のＡ列からＧ列と４行目**のＡ列からＧ列を順番に比較し不一致だったらセル値を右へ一つ移動する。

とのことですが、
１．ソースをみると、For x = 3 To 17になっていて、C列からP列が対象になっています。
Ａ列からＧ列が正しいのか、C列からP列が正しいのか、どちらなのでしょうか。

２．ソースをみると、比較を開始する行は４行目からになっています。
３行目は比較対象ではありません。３行目は比較するのでしょうか。それとも比較しないのでしょうか。

３．セルを比較するときに、InStrを使用しています。
これは、search_strの文字列内にbase_str の文字列がが含まれるか否かの判断です。
search_strの文字列とbase_str の文字列が一致か不一致かの判断ではありません。
①search_strの文字列内にbase_str の文字列が含まれないならセルを右へ移動する。
②search_strの文字列とbase_str の文字列が不一致ならセルを右へ移動する。
上記の①と②のどちらなのでしょうか。

Answer 3

シートの内容が不明なので、具体的にどのような処理なのか分かりませんが、おそらく可能だと思います。
下記のリンク先などを参考にしてください。

VBA　セル範囲の配列化後の処理について

Office TANAKA - VBA高速化テクニック[配列を使う]

---

質問のコードを機械的に、配列を使用したものに変換しました。
シートの詳細ややりたいことの説明が不十分なので、動作確認はしてません。

Sub test()
    Dim ws As Worksheet
    Set ws = Sheets("test1")

    Dim last_row As Long, x As Long, y As Long, z As Long
    last_row = ws.Cells(Rows.Count, 1).End(xlUp).Row
    x = 3
    y = 4

    Dim base_str As String, search_str As String
    
    'セル範囲を配列に格納
    Dim ary() As Variant
    ary = ws.Range(ws.Cells(1, 1), ws.Cells(last_row, 17)).Value

    Do While y <= last_row
        For x = 3 To 17
            base_str = ary(2, x)
            search_str = ary(y, x)
            If InStr(search_str, base_str) = 0 Then
                'セル値を右へ一つ移動
                For z = 16 To x Step -1
                    ary(y, z + 1) = ary(y, z)
                Next
                ary(y, x) = ""
            End If
        Next x
        y = y + 1
    Loop
    '配列をセル範囲に代入
    ws.Range(ws.Cells(1, 1), ws.Cells(last_row, 17)).Value = ary

End Sub

セル範囲⇔配列（マクロVBA高速化必須テクニック）｜VBA入門