回答編集履歴

1

コード追記

2022/08/26 07:28

投稿

hatena19
hatena19

スコア33759

test CHANGED
@@ -5,4 +5,44 @@
5
5
 
6
6
  [Office TANAKA - VBA高速化テクニック[配列を使う]](http://officetanaka.net/excel/vba/speed/s11.htm)
7
7
 
8
+ ---
9
+ 質問のコードを機械的に、配列を使用したものに変換しました。
10
+ シートの詳細ややりたいことの説明が不十分なので、動作確認はしてません。
11
+
12
+ ```vba
13
+ Sub test()
14
+ Dim ws As Worksheet
15
+ Set ws = Sheets("test1")
16
+
17
+ Dim last_row As Long, x As Long, y As Long, z As Long
18
+ last_row = ws.Cells(Rows.Count, 1).End(xlUp).Row
19
+ x = 3
20
+ y = 4
21
+
22
+ Dim base_str As String, search_str As String
23
+
24
+ 'セル範囲を配列に格納
25
+ Dim ary() As Variant
26
+ ary = ws.Range(ws.Cells(1, 1), ws.Cells(last_row, 17)).Value
27
+
28
+ Do While y <= last_row
29
+ For x = 3 To 17
30
+ base_str = ary(2, x)
31
+ search_str = ary(y, x)
32
+ If InStr(search_str, base_str) = 0 Then
33
+ 'セル値を右へ一つ移動
34
+ For z = 16 To x Step -1
35
+ ary(y, z + 1) = ary(y, z)
36
+ Next
37
+ ary(y, x) = ""
38
+ End If
39
+ Next x
40
+ y = y + 1
41
+ Loop
42
+ '配列をセル範囲に代入
43
+ ws.Range(ws.Cells(1, 1), ws.Cells(last_row, 17)).Value = ary
44
+
45
+ End Sub
46
+ ```
47
+
8
48
  [セル範囲⇔配列(マクロVBA高速化必須テクニック)|VBA入門](https://excel-ubara.com/excelvba1/EXCELVBA414.html)