レッスン-投稿一覧パソコン仕事５倍塾ポータル

投稿/コメントを表示します。

田中宏明さんの投稿

(投稿ID: 5157)

以下の手法で実装できました。記念に投稿します。
　①連想配列にCollectionを格納
　②Collectionに１次元配列を格納

Sub mondai5_Col_Array()
    '初期化
    Dim cMx As Long
    cMx = Range("O" & Rows.Count).End(xlUp).Row
    If cMx > 1 Then
        Range("J2:O" & cMx).ClearContents
    End If
    
    'データ取得
    Dim cFm As Long
    Dim dic As New Scripting.Dictionary
    Dim st As String
    For cFm = 2 To Range("A" & Rows.Count).End(xlUp).Row
        st = Range("C" & cFm).Value
        If Not dic.Exists(st) Then
            '①DictionaryのItemにCollectionを格納
            dic.Add st, New Collection
        End If
        '②CollectionのItemに一次元配列を格納
        dic.Item(st).Add _
        Array(Range("F" & cFm).Value, Range("D" & cFm).Value, Range("E" & cFm).Value, Range("G" & cFm).Value)
    Next
    
    '結果出力
    Dim ar As Variant 'Collectionからの取出し（一次元配列）
    Dim cTo As Long
    Dim sp() As String
    cTo = 2
    For cFm = 0 To dic.Count - 1
        st = dic.Keys(cFm)
        Range("J" & cTo).Value = st & "のマンションは" & dic.Item(st).Count & "件ヒットしました！"
        cTo = cTo + 1
        For Each ar In dic.Item(st)
            Range("K" & cTo).Value = ar(0)
            Range("L" & cTo).Value = ar(1)
            Range("M" & cTo).Value = ar(2)
            sp = Split(ar(3), "/")
            Range("N" & cTo).Value = sp(0)
            Range("O" & cTo).Value = sp(1)
            cTo = cTo + 1
        Next
        cTo = cTo + 1
    Next
End Sub

2021/07/11 02:04

小川慶一さんのコメント

(コメントID: 7298)

田中宏明さん:

ありがとうございます。

以下、おもしろいですね (^^

dic.Item(st).Add Array(Range("F" & cFm).Value, Range("D" & cFm).Value, Range("E" & cFm).Value, Range("G" & cFm).Value)

以下も、取り出し方が鮮やか (^^

For Each ar In dic.Item(st)
    ...
    ...
    ...
Next

よいお手本になりそう。

せっかくなんで（？）列順序入れ替えの可能性を考慮した、インデックス値の定数化をしてみました。
(動作確認していませんが...雰囲気はこんな感じかと)

Sub mondai5_Col_Array()
    Const I_MANSIONNAME = 0
    Const I_LOCATION = 1
    Const I_STATION = 2
    Const I_STRUCTURE = 3
    
    '初期化
    Dim cMx As Long
    cMx = Range("O" & Rows.Count).End(xlUp).Row
    If cMx > 1 Then
        Range("J2:O" & cMx).ClearContents
    End If
    
    'データ取得
    Dim cFm As Long
    Dim dic As New Scripting.Dictionary
    Dim st As String
    For cFm = 2 To Range("A" & Rows.Count).End(xlUp).Row
        st = Range("C" & cFm).Value
        If Not dic.Exists(st) Then
            '①DictionaryのItemにCollectionを格納
            dic.Add st, New Collection
        End If
        '②CollectionのItemに一次元配列を格納
        dic.Item(st).Add Array(Range("F" & cFm).Value, Range("D" & cFm).Value, Range("E" & cFm).Value, Range("G" & cFm).Value)
    Next
    
    '結果出力
    Dim ar As Variant 'Collectionからの取出し（一次元配列）
    Dim cTo As Long
    Dim sp() As String
    cTo = 2
    For cFm = 0 To dic.Count - 1
        st = dic.Keys(cFm)
        Range("J" & cTo).Value = st & "のマンションは" & dic.Item(st).Count & "件ヒットしました！"
        cTo = cTo + 1
        For Each ar In dic.Item(st)
            Range("K" & cTo).Value = ar(I_MANSIONNAME)
            Range("L" & cTo).Value = ar(I_LOCATION)
            Range("M" & cTo).Value = ar(I_STATION)
            sp = Split(ar(I_STRUCTURE), "/")
            Range("N" & cTo).Value = sp(0)
            Range("O" & cTo).Value = sp(1)
            cTo = cTo + 1
        Next
        cTo = cTo + 1
    Next
End Sub

2021/07/12 02:21