回答編集履歴
1
コード追記
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)
|