Q&A
上手くいかない の詳細を書いてください。
例えばdc.Add list, .Cells(I, "D")のところで既にキーが割り当てられているというメッセージが出ます。 とか
表題の通り、配列に関してItemの格納がいかない点について、
ご質問させてください。
配列そのもの自体の概念の知識不足によるものから
発生していることは重々承知の上ご質問させて頂いてる次第です。
【やりたいことの一連の流れ】
1.入力シートにあるデータを配列へ
2.重複しないkeyの格納
3.keyと紐づくitemの格納
4.転記データにある転記シートを一番最後にコピー作成
5.転記シート内セルF4にKeyを転記
6.Keyと紐づくアイテムを転記
7.シート名をKeyに変更
8.keyの数だけ繰り返し処理
と上記の流れで処理を行いたいと考えております。、
"Keyの格納→シートコピー→シート名をKeyに変更"
の流れであればうまく動作するのですが、
keyに紐づくitem格納の部分で躓いてる状況にあります。
恐らくitemがうまく連動（格納）されていないことから
上手くいっていないものと思われるのですが、どうか有識者の方のお力をお借りしたく
ご質問させていただきました。
また補足点や何か不足内容があれば追記いたしますので、
ご教示の程よろしくお願いいたします。
【追記】
画像あった方が伝わりやすいかと思い画像を追加させていただきました。
▼重複について
シート名の転記時に使用する時に使用する重複しないリストを作成、
Keyに紐づくitemは重複の有無関係なくKeyが同様であれば転記を行いたいと考えています。
VBA
1 For I = 9 To wb2Row 2 3 list = .Cells(I, "E").Value 'Key&item 4 5 '未登録がある場合は登録(重複防止) 6 If Not dc.exists(list) Then 7 dc.Add list, "" 8 End If
上記コード部分で重複判別している認識なのですが、誤りでしょうか..?
VBA
1Option Explicit 2 3 4Sub 別ブックシート転記() 5 6'----------------------------------------------------------------------------- 7'Thisworkbookを変数へ格納 8'----------------------------------------------------------------------------- 9Dim wb1 As Workbook 10Set wb1 = ThisWorkbook 11 12'----------------------------------------------------------------------------- 13'転記データの取得・展開 14'----------------------------------------------------------------------------- 15Dim path2 As String 16path2 = ThisWorkbook.Sheets("データ元").Range("D2") 17 18Dim datename2 As String 19datename2 = "転記Date.xlsx" 20 21Dim wb2 As Workbook 22Workbooks.Open (path2 & "\" & datename2), ReadOnly:=False 23Set wb2 = Workbooks(datename2) 24'----------------------------------------------------------------------------- 25Application.ScreenUpdating = False 26 27Dim dc As Object 28Dim list As String 29Dim I, L As Long 30Dim wb2Row As Long 31 32 33Set dc = CreateObject("Scripting.Dictionary") 'dcの作成 34 35With wb1.Sheets("入力") 36wb2Row = .Cells(Rows.Count, "C").End(xlUp).Row 37 For I = 9 To wb2Row 38 39 list = .Cells(I, "E").Value 'Key&item 40 41 '未登録がある場合は登録(重複防止) 42 If Not dc.exists(list) Then 43 dc.Add list, "" 44 End If 45'------------------------------------------------------------------------------------ 46 'Keyに紐づくitemの格納 47 dc.Add list, .Cells(I, "D") 'No. 48 dc.Add list, .Cells(I, "M") 'Code 49 dc.Add list, .Cells(I, "H") 'Name 50'------------------------------------------------------------------------------------ 51 Next I 52End With 53 54wb2.Activate 55 56For L = 0 To dc.Count - 1 57 wb2.Sheets("転記").copy after:=Worksheets(Worksheets.Count) 58 wb2.Sheets("転記(2)").Range("F4") = dc.keys()(L) 'Keyの転記 59 60'------------------------------------------------------------------------------------ 61 wb2.Sheets("転記(2)").Cells(I + 10, "C") = dc.Items()(1) 'Item1の転記-No. 62 wb2.Sheets("転記(2)").Cells(I + 10, "D") = dc.Items()(2) 'Item2の転記-Code 63 wb2.Sheets("転記(2)").Cells(I + 10, "E") = dc.Items()(3) 'Ite3の転記-Name 64'------------------------------------------------------------------------------------ 65 66 wb2.Sheets("転記(2)").Name = dc.keys()(L) 'Keyの転記 67Next L 68 69Application.ScreenUpdating = True 70 71 72End Sub 73 74 75
neconekocatさん
ありがとうございます。
確かにうまく行かないの詳細が記載されておらず申し訳ございません。
まさに指摘頂いた(dc.Add list, .Cells(I, "D"))の部分に
"このキーは既にこのコレクションの要素に割り当てられています"と表示されます。
またここに質問させて頂く前までに自分なりにネット上へ確認したところ、
Dictionary自体はそもそも重複したキーの格納が仕様上出来ないと記載があったため、
Keyに紐づく転記を行いたい場合はどのように処理を行うのが適切なのか
ご教示頂きたく質問させていただきました。
恐れ入りますが、ご確認のほどよろしくお願いいたします。
正直なところ、いくつかの質問に分けた方がいいと思います。
格納処理に絞って聞きますので、質問内容に追記ください。
・キーに重複があった場合どうするのか(例えば10行目と11行目のE列の値が同じ場合はどちらの行の値を転記するのか)
・dcにどんな値を入れたいのか(配列を格納したい？)
再度ありがとうございます。
追記させていただきましたので、
ご確認頂けると幸いです。
また拙い説明で余計ややこしくなっている可能性は否めないので、
画像を追加させて頂きました。
あぁなるほど・・・なるほど・・・
そういう事をやりたかったわけですか・・・
回答2件
0
せっかくなのでCollectionを使用するやり方も書いときますね。
VBA
1 '格納 2 For I = 9 To wb2Row 3 list = .Cells(I, "E").Value 'Key 4 5 If Not dc.exists(list) Then 6 dc.Add list, new Collection 7 End If 8 9 'Keyに紐づくitemの格納 10 dc(list).Add Array(.Cells(I, "D"), .Cells(I, "M"), .Cells(I, "H")) 11 Next I 12 13 '転記 14 Dim v As Variant, v2 As Variant 15 Dim row As Long 16 For Each v In dc 17 wb2.Sheets("転記").copy after:=Worksheets(Worksheets.Count) 18 wb2.Sheets("転記(2)").Range("F4") = v 19 wb2.Sheets("転記(2)").Name = v 20 21 row = 10 22 For Each v2 In dc(v) 23 wb2.Sheets(v).Cells(row, "C") = v2(0) 'Item1の転記-No. 24 wb2.Sheets(v).Cells(row, "D") = v2(1) 'Item2の転記-Code 25 wb2.Sheets(v).Cells(row, "E") = v2(2) 'Item3の転記-Name 26 27 row = row + 1 28 Next 29 Next
投稿2021/07/09 08:30
編集2021/07/09 15:01総合スコア443
noconekocatさん
ご丁寧に回答頂いたにも関わらず、返信遅くなり大変申し訳ございません。
ご提示頂いたCollectionを用いた処理について、
コードを１つずつ紐解いて勉強させていただきます。
ちなみに..Collectionを用いたやり方について、
自分なりにネット上や参考書を確認した際にCollectionの存在は存じ上げていました。
当初は配列とどう異なるのかわからずしまいで食わず嫌いのような感じで避けておりました。
①If文とFor文を組み合わせての処理
②配列を用いての処理
③Collectionを用いての処理
と多くのやり方があることからどこでどの処理方法を採用するか、
適切な選定が出来ていないから理解ができていないのだろうとひしひしと感じました...。
またどこかで質問することもあるかと思いますが、
その際はneconekocatさんにとっても有意義な質問になれるようより勉強させていただきます。
改めてになりますが、ご丁寧に別の視点からのやり方をご教示頂いたことにより
自分の知識が蓄えたのは事実であり、私にとって大変勉強になった一日となりました。
大変ありがとうございました。
0
ベストアンサー
こんな感じですかね。
VBA
1'先勝ちの場合 2 For I = 9 To wb2Row 3 List = .Cells(I, "E").Value 4 If Not dc.Exists(List) Then 5 dc.Add List, Array(.Cells(I, "D"), .Cells(I, "M"), .Cells(I, "H")) 6 End If 7 Next I
VBA
1'後勝ちの場合 2 For I = 9 To wb2Row 3 List = .Cells(I, "E").Value 4 dc(List) = Array(.Cells(I, "D"), .Cells(I, "M"), .Cells(I, "H")) 5 Next I
＜追記＞
やりたいことを取り違えていたようなので修正。
VBA
1 Dim arr 2 For I = 9 To wb2Row 3 List = .Cells(I, "E").Value 4 If Not dc.Exists(List) Then 5 dc.Add List, Array(Array(.Cells(I, "D"), .Cells(I, "M"), .Cells(I, "H"))) 6 Else 7 arr = dc(List) 8 ReDim Preserve arr(UBound(arr) + 1) 9 arr(UBound(arr)) = Array(.Cells(I, "D"), .Cells(I, "M"), .Cells(I, "H")) 10 dc(List) = arr 11 End If 12 13 Next I 14 15 16Dim dcKey, dcItem 17 18For L = 0 To dc.Count - 1 19 dcKey = dc.Keys(L) 20 dcItem = dc.Items(L) 21 22 wb2.Sheets("転記").copy after:=Worksheets(Worksheets.Count) 23 wb2.Sheets("転記(2)").Name = dcKey 'Keyの転記 24 wb2.Sheets(dcKey).Range("F4") = dcKey 'Keyの転記 25 26 Dim v, j 27 j = 10 28 For Each v In dcItem 29 wb2.Sheets(dcKey).Cells(I + j, "C") = v(0) 30 wb2.Sheets(dcKey).Cells(I + j, "D") = v(1) 31 wb2.Sheets(dcKey).Cells(I + j, "E") = v(2) 32 j = j + 1 33 Next 34Next L 35
＜再追記＞
VBA
1 For I = 9 To wb2Row 2 List = .Cells(I, "E").Value 3 If Not dc.Exists(List) Then 4 wb2.Sheets("転記").Copy after:=Worksheets(Worksheets.Count) 5 wb2.Sheets("転記(2)").Name = List 6 wb2.Sheets(List).Range("F4") = List 7 dc(List) = 10 8 End If 9 10 wb2.Sheets(List).Cells(dc(List), "C") = .Cells(I, "D").Value 11 wb2.Sheets(List).Cells(dc(List), "D") = .Cells(I, "M").Value 12 wb2.Sheets(List).Cells(dc(List), "E") = .Cells(I, "H").Value 13 dc(List) = dc(List) + 1 14 Next I 15
Sub sample() Dim wb1 As Workbook Dim wb2 As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = wb1.Sheets("入力") Set ws2 = wb2.Sheets("転記") Dim dc As Scripting.Dictionary Set dc = CreateObject("Scripting.Dictionary") Dim inData, inCount With ws1 inData = .Range(.Range("C9"), .Cells.SpecialCells(xlCellTypeLastCell)).Value inCount = UBound(inData, 1) End With Dim i, k, arr For i = 1 To inCount k = inData(i, 5) arr = Array(inData(i, 4), inData(i, 13), inData(i, 8), inData(i, 9) + inData(i, 10), inData(i, 11), inData(i, 12)) If Not dc.Exists(k) Then dc.Add k, CreateObject("Scripting.Dictionary") dc(k).Add dc(k).Count, arr Next Dim j j = 10 For Each k In dc wb2.Sheets("転記").Copy After:=Worksheets(Worksheets.Count) Set ws3 = wb2.Sheets("転記(2)") With ws3 .Name = k .Range("F4") = k For Each arr In dc(k).Items .Cells(j, 3).Resize(, 4).Value = Array(arr(0), arr(1), arr(2), arr(3)) .Cells(j + 1, 3).Resize(, 4).Value = Array(arr(0), arr(1), arr(2), arr(4)) j = j + 2 Next End With Next End Sub
投稿2021/07/09 06:25
編集2021/07/09 11:39
総合スコア4592
jinojiさん
ご回答頂きありがとうございます。
最終的に質問に記載しているコードになっていますが、
当初Arrayも合わせて検討しており、試してみたところエラーは発生しないものの
itemキーがうまく転記されませんでした。
そもそもコードの組み合わせ自体が間違っているのでしょうか？
プロパティから確認すると・・・
僕の認識では ".Cells(I, "E")"がKeyとして格納されているつもりが
itemとして格納されている?ようです。
※そもそも僕が思う配列自体の概念が誤っているかも知れませんが・・・。
jinojiさん
丁寧に２つの手法まで記載頂きありがとうございます。
結論から申し上げると、質問しなかったら多分正常に動くまでかなりの時間を要していたと思われます。
全て理解するには少し時間が必要なので改めてゆっくり確認させて頂き、
最終的に解決方法の方へ記載させていただきます。
また一部気になる点についてご質問させてください。
頂いたコードの場合は1行ずつ転記していく形になっているかと思うのですが、
あるitemを2行に分けて転記させる場合はどのような形になりますでしょうか。
→考えうるやり方としては、頂いたコードで一連の転記完了後に再度配列作成→転記済の最終行へ転記という流れになりますでしょうか
イメージとしては以下の通りです。
A 列 ｜ B列 ｜C列 | D列 | E列 |
ばなな ｜1000｜500| 250 | 100 |
↓
ばなな 1500(B列+C列)
ばなな 350(D列+E列)
２つ目のコードを基にするなら
wb2.Sheets(List).Cells(dc(List), "C") = .Cells(I, "D").Value
wb2.Sheets(List).Cells(dc(List), "D") = .Cells(I, "M").Value
wb2.Sheets(List).Cells(dc(List), "E") = .Cells(I, "H").Value
wb2.Sheets(List).Cells(dc(List), "F") = .Cells(I, "I").Value + .Cells(I, "J").Value
wb2.Sheets(List).Cells(dc(List) + 1, "C") = .Cells(I, "D").Value
wb2.Sheets(List).Cells(dc(List) + 1, "D") = .Cells(I, "M").Value
wb2.Sheets(List).Cells(dc(List) + 1, "E") = .Cells(I, "H").Value
wb2.Sheets(List).Cells(dc(List) + 1, "F") = .Cells(I, "K").Value + .Cells(I, "L").Value
dc(List) = dc(List) + 2
みたいなことですか？
Jiojiさん
仰る通りです。
その2つ目のコードを1つ目のコードにて対応する場合のやり方をご教示頂くことができると
大変助かります。※勉強不足で大変申し訳ございません。。
当初は2つ目のコードに似たような形で対応していたのですが、
処理に時間掛かってしまうことからできるだけ全て配列にて対応を行いたいためとなります。
お手すきの時にでも大丈夫ですので、ご教示の程よろしくお願いいたします。
1つ目のコードを生かすなら、
前半の配列格納で Array(D列 ,M列 ,H列 ,I列+J列 ,K列+L列 ) として、
後半で
For Each v In dcItem
wb2.Sheets(dcKey).Cells(j, "C") = v(0)
wb2.Sheets(dcKey).Cells(j, "D") = v(1)
wb2.Sheets(dcKey).Cells(j, "E") = v(2)
wb2.Sheets(dcKey).Cells(j, "F") = v(3)
wb2.Sheets(dcKey).Cells(j + 1, "C") = v(0)
wb2.Sheets(dcKey).Cells(j + 1, "D") = v(1)
wb2.Sheets(dcKey).Cells(j + 1, "E") = v(2)
wb2.Sheets(dcKey).Cells(j + 1, "F") = v(4)
j = j + 2
Next
とする感じでしょうか。
Jinojiさん
再度ありがとうございます。
単純の言い方はどうかと思いますが、
シンプルに考えるとそういうやり方で良いのですね。
配列に持っていかれてどこかで難しく考えてしまっていた感は否めないかも知れません。
私事ですがこれまでは少し手間はかかるもののFor文とIf文組わせて処理を行っていた身で
最近になり配列の魅力・使いようではかなり有意義に使えるものと知ってから
勉強をしている身でJiojiさんの模範コードは大変勉強になりました。
ありがとうございます。
まだご教示頂いたコードについては、
それぞれのコードがどのように処理が行われているのか、
少し追いついていないため時間をかけて1つずつ紐解いて勉強させていただきます。
後日、改めて解決方法に完全版のコードを記載させていただきます。
あなたの回答
tips
プレビュー
