二次元配列で重複があった場合にレコードの削除をしたい

前提

以前にこちらで質問をしたのですが、少し内容が変わってしまい解消できないでいます。
https://teratail.com/questions/k87k27iad1j3pc

以前の質問では、CSVファイルでの重複処理を目標としていましたが、今回悩んでいるのは二次元配列内での重複処理の方法です。

以前質問した内容は以下となります。
ーーーーーーーーーーーーーーーーーー

上記ファイルの画像があります。
IDが重複しているレコードがあった場合（画像でいうa1、a3、a4）点検に〇がついているレコードを残し、実施に〇がついているレコードを削除したいです。
以下画像のようにしたいです。

画像では９行までしかデータがありませんが、実際には10万行以上のデータがある為高速化の重複加工作業を目指しています。
ーーーーーーーーーーーーーーーーーーーーーーーー

以前考えていた手順
スタート：データの入った二次元配列がある。
１　　　：二次元配列を一度CSVファイルに出力する。
２　　　：以前teratailで質問した方法でCSVファイルの重複除去を行う。
３　　　：重複除去後に再度CSVファイルを二次元配列に読み込み次の処理を行っていく・・・。

前回はCSVファイルを直接加工する方法で、重複があった場合にレコードの削除をしていたのですが、二次元配列にデータが入っている状態で重複除去ができないかと考えました。
なぜなら一度出力してから再度読み込むのは効率が悪いのではないかと考えたからです。

速度のことを考えても以下の手順が実現できるのであれば、速度アップが見込めるのではないかと考えました。
スタート：データの入った二次元配列がある。
１　　　：二次元配列内で、重複除去を行う。
２　　　：次の処理を行っていく。

そこで以前の質問の返答から、連想配列を使用すれば二次元配列のままでも高速化ができるのではないかと考えました。
しかし、重複があった際に二次元配列で行を削除しようとすると.deleteが使用できませんでした。

実現したいこと

二次元配列内でIDの値に重複があった場合、
点検に〇がついているレコードを残し、実施に〇がついているレコードを削除したい。
出来る限り高速で実現したい。

発生している問題・エラーメッセージ

以下２つのスクリプトを実行させると、.deleteの箇所でエラーが発生してしまう。
この部分のエラーを解消できないでしょうか。
高速化の観点から全く別の書き方があれば教えていただきたいです。

該当のソースコード

vba
1'こちらが二次元配列の変数aryです。
2    Dim ary(8, 6) As Variant    
3    ary(0, 0) = "ID"
4    ary(0, 1) = "都道府県"
5    ary(0, 2) = "実施"
6    ary(0, 3) = "点検"
7    ary(0, 4) = "備考1"
8    ary(0, 5) = "備考2"
9    ary(0, 6) = "備考3"
10    ary(1, 0) = "a1"
11    ary(1, 1) = "東京"
12    ary(1, 2) = "〇"
13    ary(1, 3) = ""
14    ary(1, 4) = "-"
15    ary(1, 5) = "-"
16    ary(1, 6) = "-"
17    ary(2, 0) = "a2"
18    ary(2, 1) = "埼玉"
19    ary(2, 2) = "〇"
20    ary(2, 3) = ""
21    ary(2, 4) = "-"
22    ary(2, 5) = "-"
23    ary(2, 6) = "-"
24    ary(3, 0) = "a3"
25    ary(3, 1) = "神奈川"
26    ary(3, 2) = "〇"
27    ary(3, 3) = ""
28    ary(3, 4) = "-"
29    ary(3, 5) = "-"
30    ary(3, 6) = "-"
31    ary(4, 0) = "a4"
32    ary(4, 1) = "千葉"
33    ary(4, 2) = "〇"
34    ary(4, 3) = ""
35    ary(4, 4) = "-"
36    ary(4, 5) = "-"
37    ary(4, 6) = "-"
38    ary(5, 0) = "a5"
39    ary(5, 1) = "山梨"
40    ary(5, 2) = ""
41    ary(5, 3) = "〇"
42    ary(5, 4) = "-"
43    ary(5, 5) = "-"
44    ary(5, 6) = "-"
45    ary(6, 0) = "a1"
46    ary(6, 1) = "東京"
47    ary(6, 2) = ""
48    ary(6, 3) = "〇"
49    ary(6, 4) = "-"
50    ary(6, 5) = "-"
51    ary(6, 6) = "-"
52    ary(7, 0) = "a3"
53    ary(7, 1) = "神奈川"
54    ary(7, 2) = ""
55    ary(7, 3) = "〇"
56    ary(7, 4) = "-"
57    ary(7, 5) = "-"
58    ary(7, 6) = "-"
59    ary(8, 0) = "a4"
60    ary(8, 1) = "千葉"
61    ary(8, 2) = ""
62    ary(8, 3) = "〇"
63    ary(8, 4) = "-"
64    ary(8, 5) = "-"
65    ary(8, 6) = "-"
66

vba
1Sub duplicateDelete()
2     
3    Application.ScreenUpdating = False
4    
5    Dim jisshi As Object
6    Dim tenken As Object
7    Dim delete As Collection
8    Dim i As Double
9    Dim max_row As Long
10    
11    Set jisshi = CreateObject("Scripting.Dictionary")
12    Set tenken = CreateObject("Scripting.Dictionary")
13    
14        max_row = UBound(ary, 1)
15        For i = 1 To max_row
16            If ary(i, 2) = "〇" Then
17                jisshi.Add ary(i, 0), i
18                
19                If tenken.exists(ary(i, 0)) Then
20                    ary.Rows(i).delete
21                End If
22            ElseIf ary(i, 3) = "〇" Then
23                tenken.Add ary(i, 0), i
24                If jisshi.exists(ary(i, 0)) Then
25                    ary.Rows(tenken.Item(ary(i, 0))).delete
26                End If
27            End If
28        Next i
29
30End Sub

こちらのスクリプトでも、やはり.deleteの部分でエラーとなってしまいます。

vba
1　 Dim dic As Object
2    Set dic = CreateObject("Scripting.Dictionary")
3
4             'C列が〇のIDをDictionaryに登録
5            Dim i As Long
6            For i = 1 To UBound(ary)
7                If ary(i, 3) = "〇" Then dic(ary(i, 0)) = i
8            Next
9
10          'D列が〇でかつIDがDictionaryに存在するときA列を"×"に
11            For i = 1 To UBound(ary)
12                If ary(i, 2) = "〇" Then
13                If dic.Exists(ary(i, 0)) Then ary(i, 0) = "×"
14                End If
15            Next
16    
17            Cells(1).AutoFilter Field:=1, Criteria1:="×" 'A列が×の行を抽出
18            Cells(1).CurrentRegion.Offset(1).EntireRow.delete '行削除
19            Cells(1).AutoFilter
20

調べたこと

ネットで調べた限りでは、二次元配列での行指定の削除に関して.deleteのようなものはないらしく、
以下のURLに書かれているようにプロシージャを使用するしかなさそうです。
http://blog.livedoor.jp/aero_iki-jibundakemacro/archives/30587497.html
ただ、高速の観点から考えるとこれが正解と言ってよいのかはなはだ疑問です。

補足情報（FW/ツールのバージョンなど）

MicroSoftOffice2019

行動規範の内容に同意します

回答1件

ベストアンサー

配列から行を削除するというという機能はないので、新規の配列に削除行以外の行をコピーするという方法になります。
http://blog.livedoor.jp/aero_iki-jibundakemacro/archives/30587497.html
も同様の方法になってます。(ただし、無駄が多いコードなのでお勧めしません。)

前回の質問の私の回答と同じロジックでDictionaryを利用して、配列の不要行の先頭列に"×"を入力して、その行以外を新規配列にコピーすればいいでしょう。

vba
1Sub duplicateDeleteArray()
2    Dim ary As Variant
3    ary = GetAry()
4
5    Dim dic As Object
6    Set dic = CreateObject("Scripting.Dictionary")
7    
8    'D列が〇のIDをDictionaryに登録
9    Dim i As Long
10    For i = 1 To UBound(ary)
11        If ary(i, 3) = "〇" Then dic(ary(i, 0)) = i
12    Next
13    
14    'C列が〇でかつIDがDictionaryに存在するときA列を"×"に
15    Dim cnt As Long '削除する行数
16    For i = 1 To UBound(ary)
17        If ary(i, 2) = "〇" And dic.Exists(ary(i, 0)) Then
18            ary(i, 0) = "×"
19            cnt = cnt + 1
20        End If
21    Next
22    
23    Dim outputAry() As Variant
24    ReDim outputAry(UBound(ary) - cnt, UBound(ary, 2))
25
26    'A列が"×"でない行をoutputAryにコピー
27    Dim r As Long, c As Long
28    For i = 0 To UBound(ary)
29        If ary(i, 0) <> "×" Then
30            For c = 0 To UBound(ary, 2)
31               outputAry(r, c) = ary(i, c)
32            Next
33            r = r + 1
34        End If
35    Next
36    
37    '確認のためにシート上に配列データを出力
38    Range("A1").Resize(UBound(outputAry) + 1, UBound(outputAry, 2) + 1).Value = outputAry
39    
40End Sub
41
42
43Public Function GetAry() As Variant
44'こちらが二次元配列の変数aryです。
45    Dim ary(8, 6) As Variant
46    ary(0, 0) = "ID"
47    ary(0, 1) = "都道府県"
48    ary(0, 2) = "実施"
49    ary(0, 3) = "点検"
50    ary(0, 4) = "備考1"
51    ary(0, 5) = "備考2"
52    ary(0, 6) = "備考3"
53    ary(1, 0) = "a1"
54    ary(1, 1) = "東京"
55    ary(1, 2) = "〇"
56    ary(1, 3) = ""
57    ary(1, 4) = "-"
58    ary(1, 5) = "-"
59    ary(1, 6) = "-"
60    ary(2, 0) = "a2"
61    ary(2, 1) = "埼玉"
62    ary(2, 2) = "〇"
63    ary(2, 3) = ""
64    ary(2, 4) = "-"
65    ary(2, 5) = "-"
66    ary(2, 6) = "-"
67    ary(3, 0) = "a3"
68    ary(3, 1) = "神奈川"
69    ary(3, 2) = "〇"
70    ary(3, 3) = ""
71    ary(3, 4) = "-"
72    ary(3, 5) = "-"
73    ary(3, 6) = "-"
74    ary(4, 0) = "a4"
75    ary(4, 1) = "千葉"
76    ary(4, 2) = "〇"
77    ary(4, 3) = ""
78    ary(4, 4) = "-"
79    ary(4, 5) = "-"
80    ary(4, 6) = "-"
81    ary(5, 0) = "a5"
82    ary(5, 1) = "山梨"
83    ary(5, 2) = ""
84    ary(5, 3) = "〇"
85    ary(5, 4) = "-"
86    ary(5, 5) = "-"
87    ary(5, 6) = "-"
88    ary(6, 0) = "a1"
89    ary(6, 1) = "東京"
90    ary(6, 2) = ""
91    ary(6, 3) = "〇"
92    ary(6, 4) = "-"
93    ary(6, 5) = "-"
94    ary(6, 6) = "-"
95    ary(7, 0) = "a3"
96    ary(7, 1) = "神奈川"
97    ary(7, 2) = ""
98    ary(7, 3) = "〇"
99    ary(7, 4) = "-"
100    ary(7, 5) = "-"
101    ary(7, 6) = "-"
102    ary(8, 0) = "a4"
103    ary(8, 1) = "千葉"
104    ary(8, 2) = ""
105    ary(8, 3) = "〇"
106    ary(8, 4) = "-"
107    ary(8, 5) = "-"
108    ary(8, 6) = "-"
109    
110    GetAry = ary
111End Function

追記

重複除去した二次元配列が欲しいとのことですが、
次の処理次第ですが、連想配列に行データを格納した方がいいかもしれません。
行の追加、削除が簡単かつ高速ですし、
配列のようにFor Nextループで処理することも可能ですし、
IDでアクセスする場合、配列より高速に処理できます。

vba
1Sub duplicateDeleteDic()
2    Dim ary As Variant
3    ary = GetAry()
4
5    Dim dic As Object
6    Set dic = CreateObject("Scripting.Dictionary")
7    
8    Dim aryRow() As Variant
9    ReDim aryRow(UBound(ary, 2))
10    
11    Dim r As Long, c As Long
12    For r = 0 To UBound(ary)
13        If dic.exists(ary(r, 0)) Then
14            If dic(ary(r, 0))(2) = "〇" Then dic.Remove (ary(r, 0))
15        End If
16        For c = 0 To UBound(aryRow)
17            aryRow(c) = ary(r, c)
18        Next
19        dic(ary(r, 0)) = aryRow
20    Next
21    
22    
23    '先頭行から順にアクセスする例
24    Dim vKey
25    For Each vKey In dic
26        
27        ary = dic.Item(vKey)
28        Debug.Print ary(0), ary(1), ary(2), ary(3)
29    Next
30    
31    '特定のIDの行データを取得
32    ary = dic("a3")
33    Debug.Print ary(0), ary(1), ary(2), ary(3)
34    
35End Sub

投稿2022/10/23 16:53

編集2022/10/24 02:55

hatena19

総合スコア34352

taku-s

2022/10/24 23:54

行の削除についてばかり考えていましたが、新しい配列を用意してコピーをするという逆の発想を使うんですね。コード自体は、目新しい関数などは使用されていないはずなのに、実現可能だったことに目から鱗です！また、追記に関してもありがとうございます。こちらはまだ自分の環境では試していないのですが、連想配列に行データを格納する方法の方が良いかもしれないです。（ちなみにやりたいことは、以前もご回答していただきました以下の処理に繋がってきます。IDをキーとして繋げていく処理です。） https://teratail.com/questions/n9z6ktrk2v0403