「夫を成功」へ導く妻の秘訣 座談会

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

【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

A 回答 (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
    • good
    • 0
この回答へのお礼

助かりました

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

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

こんばんは、


就寝前なので検証などをしていませんが、、走り書きで
いくつか気になる点がありますが、、
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などで設定

違っていたらごめんなさい。。。。
    • good
    • 1
この回答へのお礼

助かりました

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

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング