いつもお世話になっています。
配列にキーを格納した際の出力方法について教えてください。
【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ベストアンサー
- 回答日時:
こんにちは、#1です。
ちゃんと仕切り直しをして考えてみます。
ご質問のコードは、プロシージャの一部なのかもしれないと推測しましたが、
不明なところを推測しても仕方ないので、書かれているもので考えます。
概ね#1なのですが、)を打ち忘れたり、無い可能性のある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)で良い事になります。
ここ迄は、#1の訂正です。申し訳ありません。
表題の 配列にキーを格納した際の出力方法について は、
Resize(UBound(myR3,1),UBound(myR3,2) などを使うと判りやすいのではないでしょうか
いくつか気になる点がありますが、、は、
myR3の扱い、これは#1に示しました
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
No.1
- 回答日時:
こんばんは、
就寝前なので検証などをしていませんが、、走り書きで
いくつか気になる点がありますが、、
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などで設定
違っていたらごめんなさい。。。。
丁寧な解説ありがとうございます!
朝、最初の回答をもとに試行錯誤してたのですが
自分じゃ解決できず、後でゆっくりやろうと思ったら
さらに詳しく説明してくださって感動しました!
そして希望通りの形になってめちゃくちゃスゴイです!!
本当に感謝です!
ありがとうございました!!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAで SendKeys "{TAB}"
-
Excelマクロで空白セルを詰めて...
-
VBA別シートの最終行の下行へ貼...
-
Excel で行を指定回数だけコピ...
-
Excel VBA インデックスの境...
-
EXCELマクロで全シート対...
-
エクセルVBAで実行時エラー...
-
エクセル:VBAで月変わりで、自...
-
エクセルですべての一覧から、...
-
配列にキーを格納した際の出力...
-
VBAで抽出とコピペのループがう...
-
12月24日のダウンタウンD...
-
歯抜けの時間を埋めて行の挿入
-
【WORD差し込み印刷】複数レコ...
-
エクセルVBA 別シートの複数の...
-
エクセルVBAで 2種のリストを...
-
excelの差込印刷で可視セルだけ...
-
代替機にキズ
-
スマホ機種変更で旧機種のGoogl...
-
iTunesから携帯への音楽の取り...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
excelの差込印刷で可視セルだけ...
-
Excel VBA インデックスの境...
-
エクセル:VBAで月変わりで、自...
-
VBA別シートの最終行の下行へ貼...
-
VBA:同じ文字列データの比...
-
エクセルVBAで 2種のリストを...
-
エクセルVBA 別シートの複数の...
-
歯抜けの時間を埋めて行の挿入
-
エクセルVBAで SendKeys "{TAB}"
-
エクセル2007で、マクロで、結...
-
VBA 貼付先範囲(行)がいっぱ...
-
vbaでコントロールブレイク
-
エクセルVBAでの日付順のデ...
-
Excel VBAでシート内全体に非表...
-
《エクセル》リストから同じ分...
-
Excelマクロ データが上書きさ...
-
VBAの処理が途中で止まる
-
エクセルVBAで実行時エラー...
-
EXCELマクロで全シート対...
おすすめ情報