連想配列_2 書き出しの配列化

Question

下記のｺｰﾄﾞは前にこのサイトから
教えていただいたｺｰﾄﾞです。
もし、わかる方いましたら
書き出しのところを配列に
できればしたのですが、
お願い申し上げます

-----------------------------------------
Option Explicit

Public Sub 商品検索()
Dim dicT As Object
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim row2 As Long
Dim key As Variant
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).row 'Sheet1 A列最終行を求める
maxrow2 = sh2.Cells(Rows.Count, 1).End(xlUp).row 'Sheet2 A列最終行を求める
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "A").Value
If key <> "" Then
dicT(key) = row1 '商品番号に対応する行番号を記憶
End If
Next
For row2 = 2 To maxrow2
key = sh2.Cells(row2, "A").Value



------------------------------------書き出し
If dicT.exists(key) = True Then
row1 = dicT(key)
sh2.Cells(row2, "B").Value = sh1.Cells(row1, "B").Value '商品名
sh2.Cells(row2, "C").Value = sh1.Cells(row1, "C").Value '日付
sh2.Cells(row2, "D").Value = sh1.Cells(row1, "D").Value '金額
Else
sh2.Cells(row2, "B").Value = ""
sh2.Cells(row2, "C").Value = ""
sh2.Cells(row2, "D").Value = ""
End If
Next
MsgBox ("完了")
End Sub

tatsu99 · Accepted Answer

No5です。
No5の追加開始から追加終了を以下のコードで置き換えてください。
Sheet3に出力しています。（Sheet3がないとエラーになります）
Ａ列：ｉの値
Ｂ列：商品名
Ｃ列：日付
Ｄ列：金額
--------------------------------------
    '追加開始
    Dim i As Long
    Dim sh3 As Worksheet
    Set sh3 = Worksheets("Sheet3")
    For i = 0 To ctr - 1
        sh3.Cells(i + 1, 1).Value = i
        sh3.Cells(i + 1, 2).Value = sname(i)
        sh3.Cells(i + 1, 3).Value = sdate(i)
        sh3.Cells(i + 1, 4).Value = price(i)
    Next
    '追加終了

めぐみん_ · Answer

No.7の補足を見て。

良くはわかりませんが、F列も存在するって事なんですね。
シート状況が全く掴めないのでこちらとしてはどうしようもないですが、ユーザー定義型（一般には構造体）で作成した方が見易いんじゃないかなと思いました。
使う・使わないは質問者さん次第ですので、時間があるようでしたら
http://officetanaka.net/excel/vba/variable/12.htm
一読してみて下さい。
配列をバラバラに宣言するよりかは可読性は良くなると思います。

めぐみん_ · Answer

No.6です。

ブラウザの関係か補足コメントはページのソースで確認しました。（うちの古いからかな？）
個人的にはFor~NextよりもFor Each~Nextを使う物で、見た目はちょっと違いますけどね。

で、シート１のA列には重複はないとして、A列をキーにB~D列をArrayにより配列として格納。
シート２に書き出す際にA列の値がDictionaryのキーに存在しなければ””を、存在すればDictionaryの値を代入する。（ちょっと書き方が違うかもですが）

Sub megu()
Dim dicT As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r1 As Range
Dim r2 As Range

Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")

With sh1
For Each r1 In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
If r1.Value <> "" Then
dicT(r1.Value) = Array(r1.Offset(, 1).Value, r1.Offset(, 2).Value, r1.Offset(, 3).Value)
End If
Next
End With

With sh2
For Each r2 In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
If dicT.Exists(r2.Value) Then
r2.Offset(, 1).Resize(, 3).Value = dicT(r2.Value)
Else
r2.Offset(, 1).Resize(, 3).Value = Array("", "", "")
End If
Next
End With

Set dicT = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

こんな感じでしょうか？

めぐみん_ · Answer

＞抽出できません。
＞なぜかわかりませんが、？

考え方は人それぞれですので一案のみですが。

最初の
For row1 = 2 To maxrow1 ~ Next で連想配列の値に配列として放り込み（又は普通の配列に代入するとか）
次の
For row2 = 2 To maxrow2 ~ Next で連想配列にキーが存在していればその値をシートに書き出す
って使い方を私はしますね。

その方がループ回数を減らせて楽ですし。

tatsu99 · Answer

No1です。
>抽出できません。
>なぜかわかりませんが、？

「抽出できない」とは、配列の内容がどこにも表示されないという意味でしょうか？
もし、そうであれば、当たり前の話です。
提示したマクロは、配列に格納して完了です。
この配列の内容は、あなたが意図的に何かのアクションを起こさなければ確認できません。
（デバッガで確認するか、以下の様な確認の為のコードを追加するか等）
もし、この内容を確認したいなら、以下のコードをマクロの最後に追加してください。
追加開始から追加終了までの部分です。

・・（途中省略）・・・
    MsgBox ("処理完了 所要時間(秒)=" & t2 - t1)
    '追加開始
    Dim i As Long
    For i = 0 To ctr - 1
        Debug.Print "i=" & i & " sname=" & sname(i) & " sdate=" & sdate(i) & " price=" & price(i)
    Next
    '追加終了
End Sub

そうすると、イミデイトウインドウに添付図のような内容が表示されます。
i=xxxxのxxxxはsname,sdate,priceの添え字です。（０から開始します）
イミデイトウインドウに表示できる量が限られているので、あまり多いと、最後の部分のみが表示されます。
（最初の部分のほうは表示されません）

イミデイトウインドウはVBEエディタ（Alt+F11で起動）の画面で、
表示→イミデイトウインドウで表示されます。

めぐみん_ · Answer

No.3です。
ミスりました。

＞この質問が『シートへの書き出しではなく【配列への代入】』を知りたいって事なら、No.1はほっといて下さい。

この質問が『シートへの書き出しではなく【配列への代入】』を知りたいって事なら、No.2はほっといて下さい。
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　＾＾＾ここ
です。

No.1さんご迷惑をおかけしました。

めぐみん_ · Answer

No.2です。

この質問が『シートへの書き出しではなく【配列への代入】』を知りたいって事なら、No.1はほっといて下さい。

めぐみん_ · Answer

書き出しを配列にしたいんですよね？
なら普通Dictionaryの値を配列にするか、Dictionaryに行番号を代入する際に配列変数に入れるかでしょう。

『書き出し』とはシートに吐き出す事を意味しているならですけど。
・・・主に私は上記の前者を使います。ReDim Preserve使うの面倒なので。
VBAを始めた時は使ってましたがVB・VC#を使い始めると面倒なのが分かってきましたし、VBAの諸先輩方も
使うのをやめてましたのでそうなりましたね。

tatsu99 · Answer

前回回答者です。
以下のようになるかと。
snameが商品名、sdateが日付、priceが金額になります。
-----------------------------
Public Sub 商品検索()
    Dim dicT As Object
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim row1 As Long
    Dim row2 As Long
    Dim key As Variant
    Dim t1 As Variant
    Dim t2 As Variant
    
    Dim sname() As Variant      '商品名テーブル
    Dim sdate() As Variant      '日付テーブル
    Dim price() As Variant      '金額テーブル
    Dim ctr As Long             '上記テーブルの件数
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).row 'Sheet1 A列最終行を求める
    maxrow2 = sh2.Cells(Rows.Count, 1).End(xlUp).row 'Sheet2 A列最終行を求める
    t1 = Timer
    For row1 = 2 To maxrow1
        key = sh1.Cells(row1, "A").Value
        If key <> "" Then
            dicT(key) = row1 '商品番号に対応する行番号を記憶
        End If
    Next
    ctr = 0
    For row2 = 2 To maxrow2
        key = sh2.Cells(row2, "A").Value
        ReDim Preserve sname(ctr)
        ReDim Preserve sdate(ctr)
        ReDim Preserve price(ctr)
        If dicT.exists(key) = True Then
            row1 = dicT(key)
            sname(ctr) = sh1.Cells(row1, "B").Value '商品名
            sdate(ctr) = sh1.Cells(row1, "C").Value '日付
            price(ctr) = sh1.Cells(row1, "D").Value '金額
        Else
            sname(ctr) = ""
            sdate(ctr) = ""
            price(ctr) = ""
        End If
        ctr = ctr + 1
    Next
    t2 = Timer
    MsgBox ("処理完了 所要時間(秒)=" & t2 - t1)
End Sub

連想配列_2 書き出しの配列化

No5です。

No.7の補足を見て。

No.6です。

＞抽出できません。

No1です。

No.3です。

No.2です。

書き出しを配列にしたいんですよね？

前回回答者です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング