配列にキーを格納した際の出力方法について

いつもお世話になっています。
配列にキーを格納した際の出力方法について教えてください。

【sheet1のB列】か、【sheet2のB列】終わりに【STB】とあった場合、下記の順番で【sheet3】にデータをまとめて転記したいです。

【sheet3】
A列・・・【sheet1】B列
B列・・・【sheet2】B列　　★sheet2
C列・・・【sheet1】D列
D列・・・【sheet1】E列
E列・・・【sheet2】AA列　 ★sheet2
F列・・・【sheet1】K列

sheet1の参照範囲・・・A1～K300000
sheet2の参照範囲・・・A1～AA300000


sheet3の転記範囲
【Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F"))】

sheet3のA4から転記するため、範囲を上記の様に書いたのですが何も転記されず、
また、試しに範囲をF列からA列に変えてみたところ
他の列は転機されたのですが、A列はすべて空白でした。

【Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "A"))】

なぜA列だけが空白になったり、なにも転記されなかったりするのでしょうか？
色々試したり検索しているのですがさっぱりわからず、
どうかアドバイスよろしくお願いします。



Sub SUMPLE()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Set sh3 = ThisWorkbook.Sheets("Sheet3")


Dim i As Long, j As Long, k As Long
Dim myKey, myR1, myR2, myR3, myAry
Dim myDic1 As Object
Set myDic1 = CreateObject("Scripting.Dictionary")


Set myR1 = Range(sh1.Cells(1, "A"), sh1.Cells(300000, "K")) '★Sheet1の範囲
Set myR2 = Range(sh2.Cells(1, "A"), sh2.Cells(300000, "AA")) '★Sheet2の範囲


With sh1
For i = 1 To 300000

If myR1(i, "B") Like "*STB" Or myR2(i, "B") Like "*STB" Then
myKey = myR1(i, "B") & "_" & myR2(i, "B") & "_" & myR1(i, "D") & "_" & myR1(i, "E") & "_" & myR2(i, "AA") & "_" & myR1(i, "K")
myDic1.Add (myKey), ""
End If
Next i


'★Sheet3に排出
myKey = myDic1.Keys
Set myR3 = Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F")) 'sheet3のA4から転記

For j = 0 To UBound(myKey)
myAry = Split(myKey(j), "_")
For k = 0 To UBound(myAry)
myR3(j + 1, k + 1) = myAry(k)
Next k
Next j

Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F")) = myR3

MsgBox "作成しました"

End With
End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2020/08/19 16:44

こんにちは、＃１です。

ちゃんと仕切り直しをして考えてみます。
ご質問のコードは、プロシージャの一部なのかもしれないと推測しましたが、
不明なところを推測しても仕方ないので、書かれているもので考えます。
概ね＃１なのですが、）を打ち忘れたり、無い可能性のある1を指定したりと（　UBound(Split(myKey(1), "_"))　）
不備が多くありました。

Dim myKey, myR1, myR2, myR3, myAry　出来るだけ型宣言できるならした方がわかり易いかも
一理あるとは思いますが、変数名見ればわかるでしょ　と　言われてしまうかもですね。

すでにお解りかと思いますが
Excel的に言うと、UBound(myR3,1)は行方向の大きさ　UBound(myR3,2)は、列方向の大きさ　ですが、
myR3が0から始まっていれば、myR3(0,0)は、UBound(myR3,1)＝0　UBound(myR3,2)＝0　
myR3(j + 1, k + 1)で1から始めていれば、UBound(myR3,1)＝1　UBound(myR3,2)＝1　
なので、1もいらないか？は、のちの処理によりますね。。

0から配列に入れていれば、
sh3.Range("A4").Resize(UBound(myR3, 1) + 1, UBound(myR3, 2) + 1) = myR3
で、sh3シートのA4セルになります。。
+1ならば、
あれば、sh3.Range("A4").Resize(UBound(myR3,1),UBound(myR3,2)で良い事になります。

ここ迄は、＃１の訂正です。申し訳ありません。


表題の　配列にキーを格納した際の出力方法について　は、
Resize(UBound(myR3,1),UBound(myR3,2)　などを使うと判りやすいのではないでしょうか

いくつか気になる点がありますが、、は、
myR3の扱い、これは＃１に示しました

myDic1.Add (myKey), ""　これは、同じキーが存在した場合、エラーが返りませんか？
つまり、一意のキーしかないと言う事でしょうか？

下記のように重複キーワードを入れないようにしなくて良いのでしょうか？
If Not myDic1.Exists(myKey) Then　myDic1.Add (myKey), ""

With sh1
この必要性が見当たりません。ですので、プロシージャの一部なのかもしれないと推測

myKey = myR1(i, "B") & "_" & myR2(i, "B") & "_" & myR1(i, "D") & "_" & myR1(i, "E") & "_" & myR2(i, "AA") & "_" & myR1(i, "K")
myKey = myDic1.Keys
これも、すこし乱暴な気がしますね

余計なことかもしれませんが、myR3を配列として変数名を変え下記のようなサンプルを書いてみました。

Sub SUMPLE()
　　Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
　　Dim i As Long, j As Long, k As Long
　　Dim Keyword As String
　　Dim myR1 As Range, myR2 As Range
　　Dim myKey, myAry, myAry1
　　Dim myDic1 As Object
　　Set myDic1 = CreateObject("Scripting.Dictionary")
　　Set sh1 = ThisWorkbook.Sheets("Sheet1")
　　Set sh2 = ThisWorkbook.Sheets("Sheet2")
　　Set sh3 = ThisWorkbook.Sheets("Sheet3")
　　Set myR1 = Range(sh1.Cells(1, "A"), sh1.Cells(300000, "K"))　　'★Sheet1の範囲
　　Set myR2 = Range(sh2.Cells(1, "A"), sh2.Cells(300000, "AA"))　　'★Sheet2の範囲

　　For i = 1 To 300000
　　　　If myR1(i, "B") Like "*STB" Or myR2(i, "B") Like "*STB" Then
　　　　　　Keyword = myR1(i, "B") & "_" & myR2(i, "B") & "_" & myR1(i, "D") & "_" & myR1(i, "E") & "_" & myR2(i, "AA") & "_" & myR1(i, "K")
　　　　　　If Not myDic1.Exists(Keyword) Then
　　　　　　　　myDic1.Add (Keyword), ""
　　　　　　Else
　　　　　　　　'使用予定があるか分かりませんが存在キーの変更やItemの追加などに
　　　　　　End If
　　　　End If
　　Next i
　　'★Sheet3に排出
　　myKey = myDic1.Keys
　　'　　　　Set myR3 = Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F"))　　'sheet3のA4から転記
　　If UBound(myKey) < 0 Then MsgBox "該当データがありません": Exit Sub
　　ReDim myAry1(UBound(myKey), UBound(Split(myKey(0), "_")))
　　For j = 0 To UBound(myKey)
　　　　myAry = Split(myKey(j), "_")
　　　　For k = 0 To UBound(myAry)
　　　　　　myAry1(j, k) = myAry(k)
　　　　Next k
　　Next j
　　'　　　　Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F")) = myR3
　　sh3.Range("A4").Resize(UBound(myAry1, 1) + 1, UBound(myAry1, 2) + 1).Value = myAry1
　　MsgBox "作成しました"

End Sub

この回答へのお礼

＃1の方にお礼を書いておりました(汗)
一応こちらにも。
ありがとうございました！

お礼日時：2020/08/19 19:06

No.1 回答者： Qchan1962 回答日時： 2020/08/19 03:04

こんばんは、

就寝前なので検証などをしていませんが、、走り書きで
いくつか気になる点がありますが、、
myKey = myR1(i, "B") & "_" & myR2(i, "B") & "_" & myR1(i, "D") & "_" & myR1(i, "E") & "_" & myR2(i, "AA") & "_" & myR1(i, "K")
がデータのすべて、、従ってmyAry = Split(myKey(j), "_")、　myR3(j + 1, k + 1) = myAry(k)が、きもとして

myR3はRange？　配列では無いのでしょうか？もし配列なら
Set myR3 = Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F")) 'sheet3のA4から転記　は不要
なぜなら、myR3(j + 1, k + 1) = myAry(k)で書き替えられているので、

ここは、配列として使い、
Redim myR3(UBound(myKey), UBound(Split(myKey(1), "_")))

UBound(Split(myKey(1), "_"))　これ、成立していなければ　5でいいかな？

myR3(j + 1, k + 1) = myAry(k)　の　1もいらないか？（上が5ならいらない）


Range(sh3.Cells(4, "A"), sh3.Cells(UBound(myKey) + 4, "F")) = myR3
は、多分こんな感じ、

sh3.Range("A4").Resize(UBound(myR3,1),UBound(myR3,2) = myR3


あ、それと　Dim myKey, myR1, myR2, myR3, myAry
出来るだけ型宣言できるならした方がわかり易いかも
Set myR1 　Set　なので　Rangeオブジェクト
　myAry =　は、配列（Variant）または省略可
纏めて代入しない場合は、配列サイズをReDimなどで設定

違っていたらごめんなさい。。。。

この回答へのお礼

丁寧な解説ありがとうございます！
朝、最初の回答をもとに試行錯誤してたのですが
自分じゃ解決できず、後でゆっくりやろうと思ったら
さらに詳しく説明してくださって感動しました！
そして希望通りの形になってめちゃくちゃスゴイです！！

本当に感謝です！
ありがとうございました！！

お礼日時：2020/08/19 19:03