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

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

エクセルマクロ・VBA発展編２

たかちゃんさんの投稿

(投稿ID: 4921)

Dictionaryの代わりに、AdvancedFileter＆Sumif使用で描いてみました。
記念に投稿します。（動作確認済み）
最初に、AdvancedFilterをB2から指定した為、愛知販売が２つ出力という謎の動きをしてしまいました。
タイトル行から指定しないとダメです。
同様に、SumIfの合計値の範囲（G列）もG2から指定してしまうと、でたらめな金額が出力されしまい
気づくのにかなり悩みました。
前回の動画コメント12563の先生の参考コードと見比べて、やっと気づきました。

■Chap02ー71　Sheet2の課題

Sub test()
    Dim rg As Range
    Set rg = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    '会社のリスト書き出し（タイトル行からの指定がポイント）
    rg.AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("I1"), Unique:=True
    
    Dim sList As Range
    Set sList = Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row)
    Dim s As Range
    Dim c As Long
    c = 2
    'rgの範囲がタイトル行からなので、G列の指定も１行目からする
    For Each s In sList
        Range("J" & c).Value = WorksheetFunction.SumIf(rg, s.Value, Range("G1:G" & Range("G" & Rows.Count).End(xlUp).Row))
        c = c + 1
    Next
End Sub

2020/11/04 10:13

田中宏明さんのコメント

(コメントID: 6925)

たかちゃんさん:

私も AdvancedFilterを再度試してみました。
Windowsでもデータ範囲（B2から指定）だと、愛知販売が２つ出力されました。これはハマりますね。

> Dictionaryの代わりに、AdvancedFileter＆Sumif使用で描いてみました。
> 記念に投稿します。（動作確認済み）
> 最初に、AdvancedFilterをB2から指定した為、愛知販売が２つ出力という謎の動きをしてしまいました。
> タイトル行から指定しないとダメです。
> 同様に、SumIfの合計値の範囲（G列）もG2から指定してしまうと、でたらめな金額が出力されしまい
> 気づくのにかなり悩みました。

2020/11/13 20:04

田中宏明さんのコメント

(コメントID: 6926)

たかちゃんさん:

私もDictionaryとRangeオブジェクトを使わず、Collectionオブジェクトだけを使ってこの演習問題を解いてみました。実務ではこんな面倒なことはしないですが、頭の体操になりますね。結構、苦労しました。

Sub GetSumAllCollection() 'Modified by 達人養成塾 Hiroaki Tanaka
    '以下では、すべてのお客さんについて、金額の合計を求める
    Worksheets("Sheet2").Activate
    
    'Collectionを２つ使ってDictionaryを模擬実現
    Dim colkey As Collection: Set colkey = New Collection 'Key
    Dim colitm As Collection: Set colitm = New Collection 'Item
    Dim st As String
    
    '取得系
    Dim cFm As Long, cNo As Long
    For cFm = 2 To 22
        st = Range("B" & cFm).Value
        If cFm > 2 Then
            cNo = keyExistsNumber(colkey, st)
            If cNo = 0 Then
                colkey.Add st
                colitm.Add New Collection
                colitm.Item(colkey.Count).Add cFm
            Else
                colitm.Item(cNo).Add cFm
            End If
        Else
            colkey.Add st
            colitm.Add New Collection
            colitm.Item(colkey.Count).Add cFm
        End If
    Next
    
    '出力系
    Dim col As Variant
    Dim cGokei As Long
    Dim cTo As Long
    cTo = 2
    For cFm = 1 To colkey.Count 'CollectionはIndexが1から始まる
        st = colkey.Item(cFm)
        cGokei = 0
        For Each col In colitm.Item(cFm)
            cGokei = cGokei + Range("G" & col)
        Next
        Range("I" & cTo).Value = st
        Range("J" & cTo).Value = cGokei
        cTo = cTo + 1
    Next
End Sub

'Collectionを検索し、見つかった文字列のItem番号を返す関数
Function keyExistsNumber(col As Collection, key As Variant) As Long
    Dim c As Long
    For c = 1 To col.Count 'CollectionはIndexが1から始まる
        If col.Item(c) = key Then
            keyExistsNumber = c
            Exit Function '見つかったら処理終了
        End If
    Next
    keyExistsNumber = 0   '見つからなかった場合
End Function

> Dictionaryの代わりに、AdvancedFileter＆Sumif使用で描いてみました。

2020/11/14 03:02

たかちゃんさんのコメント

(コメントID: 6928)

田中さん:
さすが！今のDictionaryの理解がしっかりした頃に、Collectionについても再び調べて、こちらのコードを読みに再び戻ってきます！！！

> たかちゃんさん:
>
> 私もDictionaryとRangeオブジェクトを使わず、Collectionオブジェクトだけを使ってこの演習問題を解いてみました。実務ではこんな面倒なことはしないですが、頭の体操になりますね。結構、苦労しました。

2020/11/14 08:18

田中宏明さんのコメント

(コメントID: 6934)

たかちゃんさん:

AdvancedFilter　この演習でリベンジしました。
実務では、素早い対応が必要とされることが大半なので、小川先生が最初に回答されたこのやり方が最良かもしれませんね。
たかちゃんさんとのやりとりを通じ、新しい手法を習得できました。

Sub GetSumAll_AdvancedFilter() 'Modified by 達人養成塾 Hiroaki Tanaka
    Dim rgBase As Range
    Set rgBase = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    '会社のリスト書き出し（タイトル行からの指定がポイント）
    rgBase.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I1"), Unique:=True

    Dim rg As Range
    'rgBaseの範囲がタイトル行からなので、G列の指定も１行目からする
    For Each rg In Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row).Cells
        rg.Offset(, 1).Value = Application.WorksheetFunction.SumIf(rgBase, rg.Value, rgBase.Offset(, 5))
    Next
End Sub

2020/11/15 18:55

小川慶一さんのコメント

(コメントID: 6935)

田中宏明さん、たかちゃんさん:

Advanced Filterについて公式ドキュメントを見てみました。

Advanced Filter メソッド (Excel)
https://docs.microsoft.com/ja-jp/office/vba/api/excel.range.advancedfilter

が、特にタイトル行についての記載はみつかりませんでした。

stackoverflowで調べてみると、「filter機能系のものはタイトルを含んでしまうけど、コピー完了してからコピー先の先頭セルを削除するてやりかたでどうだい？」みたいな回答をわずかにみつけるばかり。
https://stackoverflow.com/questions/31775564/advanced-filter-exclude-headers

まあ、タイトル行がもともと存在しないリストでAdvanced Filterを使いたい場合にはそういう感じにするんでしょうか。
あとは、僕なら、先頭行は、削除する代わりに、タイトル文字列を .Value で埋め込みたいところ。

2020/11/15 18:58