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

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

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

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

5回答

10858閲覧

配列に入った重複した値を一つにまとめたいです!

chanken

総合スコア12

VBA

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

1グッド

0クリップ

投稿2019/03/06 09:58

編集2019/03/08 03:23
判定判定判定判定判定判定判定判定
ABCDEGABCDEG
11111りんご国産青森100A商店11111りんご国産青森100A商店/B 商店
21111りんご国産青森100B商店22222みかん国産和歌山100C商店
32222みかん国産和歌山100C商店32222みかん国産愛媛500A商店
42222みかん国産愛媛500A商店42222マンゴー国産沖縄/宮崎500C商店
53333マンゴー国産沖縄50C商店53333マンゴー外国産メキシコ800D商店
63333マンゴー国産宮崎50C商店
73333マンゴー外国産メキシコ800D商店
81111りんご国産青森100A商店

イメージ説明

イメージとしましては写真の左の表から、右の表のように出力したいです。

現状、判定列 A,B,C,Eの部分をまとめるのは以下の記述でできたのですが
残りのD、G 写真の右の表のようにするための実装に苦戦しています。

エラーメッセージ

『インデックスが有効は範囲でにありません』
Function 重複削除(D_elements())内の
tmpAry(i) = dic.items(i) の部分でエラーが起きます。

配列に入った重複した文字を一つにまとめたいのですがうまくいかないです。。。
このエラーをどうなくすのか、他何か提案があれば知恵をおかりしたいです。

※excelはmacの2016を使っています。・Dictionaryオブジェクトがmac版だと使えないのでクラスモジュールに、動作させるコードを拾って貼り付けてます。

  

Sub

1 2 Worksheets.add After:=Worksheets(Worksheets.Count), Count:=1 3 ActiveSheet.Name = "Sheet2" 4 Sheets("Sheet1").Copy After:=Sheets("Sheet2") 5 ActiveSheet.Name = "Sheet3" 6 7 Call Test2 8 9 Call linking 10 11End Sub 12 13 14Sub Test2() 15Worksheets("Sheet3").Activate 16 Dim SH As Worksheet 17 'データの最終行を取得 18 Dim maxRow As Long 19 20 maxRow = Cells(Rows.Count, 3).End(xlUp).row 21 22 23 24 '重複しているデータを削除 25 Range("C3:H" & maxRow).RemoveDuplicates (Array(1, 2, 3, 5)) 26 27 28End Sub 29 30 Sub linking() 31 32 Worksheets("Sheet3").Activate 33 34 '判定 Aの比較変数 35 Dim p_rowA_value As Variant 36 Dim n_rowA_value As Variant 37 '判定Bの比較変数 38 Dim p_rowB_value As Variant 39 Dim n_rowB_value As Variant 40 '判定Cの比較変数 41 Dim p_rowC_value As Variant 42 Dim n_rowC_value As Variant 43 '判定のE比較変数 44 Dim p_rowE_value As Long 45 Dim n_rowE_value As Long 46 47 Dim d_i As Long 48 d_i = 4 49 50 '行カウントの変数 51 Dim row As Long 52 'sheet2の行カウント 53 Dim i As Long 54 i = 4 55 56 Dim s_row As Long 57 58 s_row = 4 59 60 '開始行 61 '値があるまでループ(判定A列を基準) 62 For row = 4 To Cells(Rows.Count, 3).End(xlUp).row 63 64 '判定A列の値 を取得 65 n_rowA_value = Worksheets("Sheet3").Cells(row, 3).Value 66 p_rowA_value = Worksheets("Sheet3").Cells(row + 1, 3).Value 67 68 '判定B列の値 を取得 69 n_rowB_value = Worksheets("Sheet3").Cells(row, 4).Value 70 p_rowB_value = Worksheets("Sheet3").Cells(row + 1, 4).Value 71 72 '判定C列の値 を取得 73 n_rowC_value = Worksheets("Sheet3").Cells(row, 5).Value 74 p_rowC_value = Worksheets("Sheet3").Cells(row + 1, 5).Value 75 76 '判定E列の値 を取得 77 n_rowE_value = Worksheets("Sheet3").Cells(row, 7).Value 78 p_rowE_value = Worksheets("Sheet3").Cells(row + 1, 7).Value 79 80 81 82 83 '判定A~C,Eの値が全て重複するかを確認(重複が途切れた時Call文にてSheet2へ転記) 84 If n_rowA_value = p_rowA_value Then 85 86 If n_rowB_value = p_rowB_value Then 87 88 If n_rowC_value = p_rowC_value Then 89 If n_rowE_value = p_rowE_value Then 90 Else 91 Call no_dupulication(n_rowA_value, n_rowB_value, n_rowC_value, n_rowE_value, i, row, s_row, d_i) 92 End If 93 Else 94 Call no_dupulication(n_rowA_value, n_rowB_value, n_rowC_value, n_rowE_value, i, row, s_row, d_i) 95 End If 96 Else 97 Call no_dupulication(n_rowA_value, n_rowB_value, n_rowC_value, n_rowE_value, i, row, s_row, d_i) 98 End If 99 Else 100 Call no_dupulication(n_rowA_value, n_rowB_value, n_rowC_value, n_rowE_value, i, row, s_row, d_i) 101 End If 102 103 Next row 104 105 106 MsgBox "END" 107 108End Sub 109 110 111Sub no_dupulication(n_rowA_value, n_rowB_value, n_rowC_value, n_rowE_value, i, row, s_row, d_i) 112 113 Dim g_row As Long 114 115 'Sheet2へ重複した値を表記(判定A,B,C,E) 116 Worksheets("Sheet2").Cells(i, 3).Value = n_rowA_value 117 Worksheets("Sheet2").Cells(i, 4).Value = n_rowB_value 118 Worksheets("Sheet2").Cells(i, 5).Value = n_rowC_value 119 Worksheets("Sheet2").Cells(i, 7).Value = n_rowE_value 120 121 122 g_row = row 123 124 Call de_test(g_row, s_row, i, d_i) 125 126 127 128 i = i + 1 129 130End Sub 131 132 133 134Sub de_test(g_row, s_row, i, d_i) 135 136Dim D_elements() As Variant 137 138 139Dim cnt As Long 140Dim l As Long 141Dim D_output As Variant 142 143 144 145 l = 0 146 147 148 cnt = g_row - s_row 149 ReDim D_elements(cnt) 150 151 For l = 0 To cnt 152 153 D_elements(l) = Worksheets("Sheet3").Cells(d_i, 6).Value 154 155 d_i = d_i + 1 156 Next l 157 158 159 160 161 'D列の中身の重複を削除 162 Buf = 重複削除(D_elements) 163 '/記号を付加して代入 164 165 arry_cnt = UBound(D_elements) - LBound(D_elements) + 1 166 167 168 D_output = Join(D_elements, "/") 169 ' 出力 170 Worksheets("Sheet2").Cells(i, 6).Value = D_output 171 172 173 174 'D列の配列を空にする 175 Erase D_elements 176 177 178 s_row = g_row + 1 179 Set dic = Nothing 180 181 182 183 184 End Sub 185 186 Function 重複削除(D_elements()) 187 Dim dic As Class1 188 Set dic = New Class1 189 Dim i As Long 190 Dim items As Variant 191 192 193 194 For i = 0 To UBound(D_elements) 195 If dic.exists(D_elements(i)) = False Then 196 dic.add D_elements(i), D_elements(i) 197 End If 198 Next i 199 200 201 202 Dim tmpAry() As Variant 203 ReDim tmpAry(dic.Count - 1) 204 205 For i = 0 To UBound(tmpAry) 206 207 tmpAry(i) = dic.items(i) 208 209 210 Next i 211 212 重複削除 = tmpAry 213 214 Set dic = Nothing 215 216 217End Function 218       拾ってきたコード↓ 219==================================================== 220''''''''''''' 221''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 222Option Explicit 223 224 225 Private itemCount As Long 226 Private dictionaryKeys As New Collection 227 Private dictionaryValues As New Collection 228 229 Public Function add(ByVal Key As String, Value As Variant) As Variant 230 itemCount = itemCount + 1 231 If exists(Key) Then 232 add = dictionaryValues.Item(Key) 233 dictionaryValues.remove Key 234 dictionaryValues.add Value, Key 235 Else 236 dictionaryKeys.add Key, Key 237 dictionaryValues.add Value, Key 238 add = Null 239 End If 240 End Function 241 242 Public Function exists(ByVal Key As String) As Boolean 243 Dim aKey 244 Dim found As Boolean 245 found = False 246 For Each aKey In dictionaryKeys 247 If aKey = Key Then 248 found = True 249 Exit For 250 End If 251 Next aKey 252 exists = found 253 End Function 254 255 Public Function remove(ByVal Key As String) As Boolean 256 If exists(Key) Then 257 dictionaryKeys.remove Key 258 dictionaryValues.remove Key 259 itemCount = itemCount - 1 260 remove = True 261 Else 262 remove = False 263 End If 264 End Function 265 266 Public Sub removeAll() 267 itemCount = 0 268 Set dictionaryKeys = New Collection 269 Set dictionaryValues = New Collection 270 End Sub 271 272 Public Property Get count() As Long 273 count = itemCount 274 End Property 275 276 Public Property Get isEmpty() As Boolean 277 If itemCount = 0 Then 278 isEmpty = True 279 Else 280 isEmpty = False 281 End If 282 End Property 283 284 285 Public Function keys() As Collection 286 Set keys = dictionaryKeys 287 End Function 288 289 Public Function items() As Collection 290 Set items = dictionaryValues 291 End Function 292 293 'This is the default property 294 Public Property Get Item(ByVal Key As String) As Variant 295 If exists(Key) Then 296 If TypeOf dictionaryValues.Item(Key) Is Object Then 297 Set Item = dictionaryValues.Item(Key) 298 Else 299 Item = dictionaryValues.Item(Key) 300 End If 301 Else 302 Item = False 303 End If 304 End Property 305 306 Public Property Let Item(ByVal Key As String, Value As Variant) 307 Me.add Key, Value 308 End Property 309
bochan2👍を押しています

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

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

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

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

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

sazi

2019/03/06 10:09

DとGを結合したものを列挙しないと、分からなくなりませんか?
m.ts10806

2019/03/06 10:19

質問は編集できますので新しい質問を立てるのではなく、多重投稿の場合でも片方削除して残した方を編集して質問を充実させてください。 また、コードはマークダウンのcode機能を利用してご提示ください
chanken

2019/03/06 10:28

ご指摘ありがとうございます。
hatena19

2019/03/06 12:09

シートのデータ例も、画像ではななくマークダウン記法のテーブルで記述してもらうと、回答者はデータ入力せずにコピーしてシートに貼り付けるだけで済むので楽なんだか。下記を使うとエクセルからコピーしたものをマークダウンテーブルに変換してくれるので楽です。 http://www.tablesgenerator.com/markdown_tables
chanken

2019/03/06 14:23 編集

このようなものがあったんですね、ご丁寧にありがとうございます。早速使わせていただきます!
guest

回答5

0

VBA

1Option Explicit 2 3Sub Macro1() 4 Dim rngTable As Range 5 6 With Worksheets 7 .Item("Sheet1").Copy after:=.Item(.Count) 8 Set rngTable = .Item(.Count).Range("A1").CurrentRegion 9 End With 10 11 Set_同じキーの指定の列の値をまとめて繋ぐ _ 12 rngTable.Columns("F"), "=CONCATENATE(D1,"" / "",F1)", True 13 Set_同じキーの指定の列の値をまとめて繋ぐ _ 14 rngTable.Columns("D"), "=CONCATENATE(A1,"" / "",B1,"" / "",C1,"" / "",E1)", False 15 rngTable.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes 16End Sub 17 18Function Set_同じキーの指定の列の値をまとめて繋ぐ(ByRef rngTarget As Range, _ 19 ByVal sMyFormula As String, _ 20 ByVal flg As Boolean) 21 Dim a As Range 22 Dim c As Range 23 Dim k As Range 24 Dim ixKey As Long 25 Dim ixReplace As Long 26 Dim i As Long 27 Dim s As String 28 Dim ss As String 29 Dim MyCol As Collection 30 31 With rngTarget.CurrentRegion 32 Set k = .Columns(.Columns.Count + 1) 33 End With 34 If flg Then 35 ixKey = 4 36 ixReplace = 6 37 Else 38 k.Formula = sMyFormula 39 ixKey = k.Column 40 ixReplace = 4 41 End If 42 With k.CurrentRegion 43 .Sort Key1:=.Columns(ixKey), Header:=xlYes 44 Application.DisplayAlerts = False 45 .Subtotal GroupBy:=ixKey, Function:=xlCount, TotalList:=.Columns.Count 46 Application.DisplayAlerts = True 47 For Each a In Intersect(.Offset(1), .Columns(ixReplace).EntireColumn).SpecialCells(xlCellTypeConstants).Areas 48 Set MyCol = New Collection 49 For Each c In a.Cells 50 ss = c.Value 51 i = MyCol.Count 52 On Error Resume Next 53 MyCol.Add ss, ss 54 On Error GoTo 0 55 If i < MyCol.Count Then s = s & "/" & ss 56 Next 57 If MyCol.Count > 1 Then a.Value = Mid(s, 2) 58 Set MyCol = Nothing 59 s = "" 60 Next 61 .CurrentRegion.RemoveSubtotal 62 End With 63 64 k.ClearContents 65 Set k = Nothing 66End Function 67 68

行き当たりばったりで書いたので、
訳わからんコードになってるかも^^;

あと、
Collectionを使ってdictionaryっぽいクラスを作ってるようだけど、
重複の排除だけに使っているなら、素直にCollectionを使えばいいように思います。

rngTable.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6)

う~ん。どうにも、マジックナンバーが気になるけど、
ヘルプ読んだ限りでは、引数省略したら全部の列を指定していることになるとも読めるけど、
重複削除してくれん(;;)

投稿2019/03/07 12:13

mattuwan

総合スコア2136

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

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

chanken

2019/03/07 12:23

ご丁寧にありがとうございます!(T_T) さっそく試してみます!
guest

0

ベストアンサー

現在、Dictionary版の方をチェックしていますが、コメントを見る前に作ってしまったので
折角なので貼っておきます

ABCDEF
1111りんご国産青森100A商店
1111りんご国産青森100B商店
2222みかん国産和歌山100C商店
2222みかん国産愛媛500A商店
3333マンゴー国産沖縄50C商店
3333マンゴー国産宮崎50C商店
3333マンゴー外国産メキシコ800D商店

1111 がA1の状態で作ってあります

vba

1Option Explicit 2 3Sub ver_Null0lluN() 4 5Dim LastRow As Integer: LastRow = Cells(1, 1).End(xlDown).Row 6Dim EndRow As Integer 7Dim Buf As Variant: Buf = Range(Cells(1, 1), Cells(LastRow, 6)) 8Dim Result As Variant 9Dim i, j, k As Integer 10Dim Store_Array() As String 11Dim Flag As Boolean 12 13With Sheets(2) 14 'Sheet2に貼り付け 15 .Range(.Cells(1, 1), .Cells(LastRow, 6)) = Buf 16 17 '重複を削除 18 .Range("A1:F" & LastRow).RemoveDuplicates (Array(1, 2, 3, 5)) 19 '重複削除後の最終行取得 20 EndRow = .Cells(1, 1).End(xlDown).Row 21 '重複削除後の表取得 22 Result = .Range(.Cells(1, 1), .Cells(EndRow, 6)) 23 24 For i = 1 To LastRow 25 For j = 1 To EndRow 26 If Buf(i, 1) = Result(j, 1) _ 27 And Buf(i, 2) = Result(j, 2) _ 28 And Buf(i, 3) = Result(j, 3) _ 29 And Buf(i, 5) = Result(j, 5) Then '判定が全部一致していたら 30 Store_Array = Split(Result(j, 6), "/") '現在取得済みの商店を/区切りで配列に分割 31 32 'フラグを立てておき、 33 '現在取得済みの商店と一致していたらフラグを外す 34 Flag = True 35 For k = 0 To UBound(Store_Array) 36 If Store_Array(k) = Buf(i, 6) Then 37 Flag = False 38 End If 39 Next 40 41 If Flag Then 'フラグが立っていたら 42 Result(j, 6) = Result(j, 6) & "/" & Buf(i, 6) 43 End If 44 Exit For 45 End If 46 Next 47 Next 48 .Range(.Cells(1, 1), .Cells(EndRow, 6)) = Result 49End With 50 51End Sub

投稿2019/03/07 11:49

編集2019/03/07 11:56
Null0lluN

総合スコア59

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

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

chanken

2019/03/08 17:10 編集

おかげさまで実装出来るようになりました。ここまで色々ありがとうございました! 一応コード貼って起きます。。。。。。 ''列指変数定'' Worksheets("Sheet1").Activate Dim LastRow As Integer: LastRow = Cells(1, 2).End(xlDown).row Dim EndRow As Integer Dim Buf As Variant: Buf = Range(Cells(1, 1), Cells(LastRow, 7)) Dim Result As Variant Dim i, j, k As Integer Dim Store_Array() As String Dim Flag As Boolean Dim d_Flag As Boolean Dim d_i As Long With Sheets(2) 'Sheet2に貼り付け .Range(.Cells(1, 1), .Cells(LastRow, 7)) = Buf '重複を削除 .Range("B1:G" & LastRow).RemoveDuplicates (Array(2, 3, 4, 6)) '重複削除後の最終行取得 EndRow = .Cells(1, 2).End(xlDown).row 'Sheet2のA列の値をクリア For d_i = 1 To LastRow Worksheets("sheet2").Cells(d_i, 1) = "" Next d_i 'Sheet2のA列のセルに連番を振る For d_i = 1 To EndRow - 1 Worksheets("sheet2").Cells(d_i + 1, 1) = d_i Next d_i '重複削除後の表取得 Result = .Range(.Cells(1, 1), .Cells(EndRow, 7)) ''=============G列============================ For i = 1 To LastRow For j = 1 To EndRow If Buf(i, 2) = Result(j, 2) _ And Buf(i, 3) = Result(j, 3) _ And Buf(i, 4) = Result(j, 4) _ And Buf(i, 6) = Result(j, 6) Then '判定が全部一致していたら Store_Array = Split(Result(j, 7), "/") '現在取得済みの商店を/区切りで配列に分割 'フラグを立てておき、 '現在取得済みの商店と一致していたらフラグを外す Flag = True For k = 0 To UBound(Store_Array) If Store_Array(k) = Buf(i, 7) Then Flag = False End If Next If Flag Then 'フラグが立っていたら Result(j, 7) = Result(j, 7) & "/" & Buf(i, 7) End If Exit For End If Next Next .Range(.Cells(1, 1), .Cells(EndRow, 7)) = Result End With '=============D列========================== With Sheets(2) For i = 1 To LastRow For j = 1 To EndRow If Buf(i, 2) = Result(j, 2) _ And Buf(i, 3) = Result(j, 3) _ And Buf(i, 4) = Result(j, 4) _ And Buf(i, 6) = Result(j, 6) Then '判定が全部一致していたら Store_Array = Split(Result(j, 5), "/") '現在取得済みの商店を/区切りで配列に分割 'フラグを立てておき、 '現在取得済みの商店と一致していたらフラグを外す d_Flag = True For k = 0 To UBound(Store_Array) If Store_Array(k) = Buf(i, 5) Then d_Flag = False End If Next If d_Flag Then 'フラグが立っていたら Result(j, 4) = Result(j, 5) & "/" & Buf(i, 5) End If Exit For End If Next Next .Range(.Cells(1, 1), .Cells(EndRow, 5)) = Result End With End Sub
Null0lluN

2019/03/09 09:23

忙しくてdirectionary型に手を出せなかったため結局解決できなくて申し訳ありません ちなみに、貼ってくださったコードですがg列とd列のプログラムは一部違うだけでほぼ同じなので、ループ分と、判定が全部一致していたら部分をまとめてしまい、 その中身だけ、判定が全部一致していたらのif文にg列のとd列のをそれぞれ書いた方がいいです
guest

0

言葉足らずで申し訳ありません。

一度コメントへの返信で書きましたが、表がMarkDownで書けなかったのでこちらに再記します。

Call Test2
Call linking

で、Test2でSheet3のデータを重複削除した後に、
それを使って、linkingで重複削除済みのSheet3のデータにさらに重複があるかをチェックしているように見受けられます
つまり、

1111りんご国産青森100A商店
1111りんご国産青森100B商店
2222みかん国産和歌山100C商店

というデータが、重複削除によって

1111りんご国産青森100A商店
2222みかん国産和歌山100C商店

とSheet3にはなります。
本来、2行目の”B商店”というデータを1行目のA商店というデータにくっつけたいわけですが、
既に削除されてしまっているので、
元データであるSheet1のデータとSheet3のデータを比較しながらでないとB商店というデータは得られないわけです。

しかし、ぱっと見た感じSheet1のデータを参照もしくはあらかじめ保存している雰囲気は見られなかったので、その点をお聞きしたかったです。

投稿2019/03/08 03:35

Null0lluN

総合スコア59

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

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

chanken

2019/03/08 05:24 編集

| 1111 | りんご | 国産 | 青森 | 100 | A商店 | | 1111 | りんご | 国産 | 青森 | 100 | A商店 | |------|----------|--------|----------|-----|-------|---|------|----------|--------|----------|-----|-------| | 1111 | りんご | 国産 | 青森 | 100 | B商店 | | 1111 | りんご | 国産 | 青森 | 100 | B商店 | | 2222 | みかん | 国産 | 和歌山 | 100 | C商店 | | 2222 | みかん | 国産 | 和歌山 | 100 | C商店 | | 2222 | みかん | 国産 | 愛媛 | 500 | A商店 | | 2222 | みかん | 国産 | 愛媛 | 500 | A商店 | | 3333 | マンゴー | 国産 | 沖縄 | 50 | C商店 | | 3333 | マンゴー | 国産 | 沖縄 | 50 | C商店 | | 3333 | マンゴー | 国産 | 宮崎 | 50 | C商店 | | 3333 | マンゴー | 国産 | 宮崎 | 50 | C商店 | | 3333 | マンゴー | 外国産 | メキシコ | 800 | D商店 | | 3333 | マンゴー | 外国産 | メキシコ | 800 | D商店 | | 1111 | りんご | 国産 | 青森 | 100 | A商店 | | | | | | | | | 1111 | りんご | 国産 | 青森 | 100 | A商店 | | | | | | | | | 1111 | りんご | 国産 | 青森 | 100 | B商店 | | | | | | | | | 2222 | みかん | 国産 | 和歌山 | 100 | C商店 | | | | | | | | | 2222 | みかん | 国産 | 愛媛 | 500 | A商店 | | | | | | | | | 3333 | マンゴー | 国産 | 沖縄 | 50 | C商店 | | | | | | | | | 3333 | マンゴー | 国産 | 宮崎 | 50 | C商店 | | | | | | | | | 3333 | マンゴー | 外国産 | メキシコ | 800 | D商店 | | | | | | | | | 1111 | りんご | 国産 | 青森 | 100 | A商店 | | | | | | | | 理解不足で何度もコメントしていただいでありがとうございます。 sheet1はただSheet3にコピーするためだけのページのように扱ってます。 ・元データであるSheet1のデータとSheet3のデータを比較しながらでないとB商店というデータは得られないわけです。 →これに関しましては私のPC上では、①マクロ起動、②重複削除の画面が出てくる(なんかチェック欄がある画面)、③前列選択、④後者の表の結果が出てくる。 そういえば、連想配列型は、キーと値のN行*2列データですが、 判定列がA,B,C,Eで判定されない列がD,Fなので キー(A,B,C,Eを一つの文字列と扱うことでキーとする)、値、値という形になり、 連想配列は出来ないような気がするのですが →これに関しましては(変なやり方かもしれないですが、あと質問に対して的を得てなかったらすみません)  判定列がABCEが揃ってる列の開始行と終了行を取得し(変数→s_row, g_row)、その行間の都道府県の列の値を全て(s_rowからg_rowまで)配列にぶちこんで、重複してれば、削除、してなければjointで(/)スラッシュつけて出力ということをしています。(現在都道府県の列のみで商店の方の記述はしてません。) 至らない点があるのは存じてますが、どうかこの言っている意味伝わればと思います。m(__)m
chanken

2019/03/08 05:24

markdown がうまく表記されないので今調べてます
guest

0

エラーが出る箇所を書いていただけるとありがたいです。(実行しなくてもその近辺をさっと見ればいいだけなので)
なお、私の環境では新しいコードと新しいエラー(8日 6:50版)では
Function 重複削除(D_elements())内の
tmpAry(i) = dic.items(i)
で同様のエラーが見られました。

もしそこでしたら、
dic.countが1になっているため、
ReDim tmpAry(dic.count - 1)=tmpAry(0)となり、そもそも配列が存在していないため起こっています。

Class1を見てみますと、
itemCountは宣言されていますが初期化されていない(結果0が入っている)です。
その結果、初めて使用されるClass1.add関数で
itemCount = itemCount + 1
が1になってしまっています。

コードを全部見ているわけではないのでどういうフローチャートになっているのかは分かりませんが、
すごく大雑把に流し見したところ、
Sheet1にもともとデータがあり(C3からデータがスタート)、Sheet2と3を作ってSheet3にSheet1のデータをコピー→Sheet3で重複削除
この後、元のデータ(Sheet1)のデータを取得しておらず、既に重複削除済みのSheet3のデータを使って処理を行おうとしている気がします。

流し見なので見落としていたらごめんなさい

投稿2019/03/08 02:58

Null0lluN

総合スコア59

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

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

chanken

2019/03/08 03:21

コメントありがとうございます。 不備があって申し訳ございません。 エラー箇所はおっしゃる部分です。 一度sheet3転記し、そこで完全に一致しているのは排除し、そこからfor文で回してsheet2へ判定列以外のデータをまとめて転記しようとしてます。(作業終了後Sheet3削除) 処理行数が3万行程あるので、一度dictionaryで完全に一致してるものは排除し、そこからfor文回した方が多少早いのではないか? という現状少ない私の引き出しからこのような結果に至りました。
Null0lluN

2019/03/08 03:33

言葉足らずで申し訳ありません。 Call Test2 Call linking で、Test2でSheet3のデータを重複削除した後に、 それを使って、linkingで重複削除済みのSheet3のデータにさらに重複があるかをチェックしているように見受けられます つまり、 | | | | | | | |:--------:|:------------:|:----------:|:------------:|:-------:|:---------:| | 1111 | りんご | 国産 | 青森 | 100 | A商店 | | 1111 | りんご | 国産 | 青森 | 100 | B商店 | | 2222 | みかん | 国産 | 和歌山 | 100 | C商店 | というデータが、重複削除によって | | | | | | | |:--------:|:------------:|:----------:|:------------:|:-------:|:---------:| | 1111 | りんご | 国産 | 青森 | 100 | A商店 | | 2222 | みかん | 国産 | 和歌山 | 100 | C商店 | とSheet3にはなります。 本来、2行目の”B商店”というデータを1行目のA商店というデータにくっつけたいわけですが、 既に削除されてしまっているので、 元データであるSheet1のデータとSheet3のデータを比較しながらでないとB商店というデータは得られないわけです。 しかし、ぱっと見た感じSheet1のデータを参照もしくはあらかじめ保存している雰囲気は見られなかったので、その点をお聞きしたかったです。
Null0lluN

2019/03/08 04:21

そういえば、連想配列型は、キーと値のN行*2列データですが、 判定列がA,B,C,Eで判定されない列がD,Fなので キー(A,B,C,Eを一つの文字列と扱うことでキーとする)、値、値という形になり、 連想配列は出来ないような気がするのですが
guest

0

ソースは省くので大雑把な回答になってしまいますが、お許しください。
あと、スマートなやり方ではないです。

私だったら、以下のような方法で力業でやります。

  1. Sheet1から表全体をSheet2にコピー
  2. Sheet2で重複しているデータを削除
  3. Sheet1で上から順にforループ i=1 to

 1. Sheet2で上から順にforループ j= 1 to
2. Sheet1とSheet2の判定がすべて一致していたらSheet2のj列目のD,GそれぞれにSheet1のD,Gの値を"/"と共に結合する

という感じです。
実際には、いったん配列として取得してforで回したほうが動作が軽くなるのでそうしますが。

投稿2019/03/06 11:17

Null0lluN

総合スコア59

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

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

chanken

2019/03/07 08:53

回答ありがとうございます。お答え下さったものとは違いますが、それに近い形で処理することにしました。 がDictionary周辺の処理がうまくいかないです。。。。。
Null0lluN

2019/03/07 12:16 編集

>『引数の数が正しくないか、またはプロパティの指定が無効です。』 はどこ(どの関数)で出たのでしょうか? そのままコピペした私の環境では、 D_elements = Dic.keys で出ましたがそこでしょうか? そしたら、keysはコレクションオブジェクトを返すやつなので、 Set D_elements = Dic.keys とする必要があるかと思います
chanken

2019/03/07 13:38 編集

D_elements = Dic.keys それを読み込むと拾ってきたコードのところに跳ぶのですが、そこでエラーになります。 確認してみたところ今度は『型が一致しません』というエラーがでました。 また原因探ってみます。。。。。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問