質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

4675閲覧

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

taku-s

総合スコア12

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2022/10/23 13:20

前提

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

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

以前質問した内容は以下となります。
ーーーーーーーーーーーーーーーーーー
イメージ説明
上記ファイルの画像があります。
IDが重複しているレコードがあった場合(画像でいうa1、a3、a4)点検に〇がついているレコードを残し、実施に〇がついているレコードを削除したいです。
以下画像のようにしたいです。
イメージ説明

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

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

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

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

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

実現したいこと

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

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

以下2つのスクリプトを実行させると、.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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

配列から行を削除するというという機能はないので、新規の配列に削除行以外の行をコピーするという方法になります。
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

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

taku-s

2022/10/24 23:54

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

2022/10/25 00:37

> IDをキーとして繋げていく処理です。 ということなら、IDで検索することになりますので、二次元配列より連想配列の方がいいと思います。
taku-s

2022/10/26 01:38

やはりそうなんですね!ありがとうございます、試してみます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問