88本目クロスABC分析表の作成 - わちょんちゃんねる

VBA100本ノック 88本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

問題
解答
dataシートから転記する
商品マスタシートから項目を取得
ABCを求めるSubプロシージャの作成
作ったプロシージャに値をぶち込む
合計に対する割合でABCの分岐
最後の仕上げと注意点
あとがたり

問題

#VBA100本ノック 88本目
「data」と「商品マスタ」から「クロスABC」を完成させる。
・仕入金額=仕入単価数量・売上金額=販売単価数量
・粗利金額=売上金額-仕入金額
・売上ABC=売上順に並べ累計構成比が、<=50%がA、<=90%がB、以外はC
・粗利ABC=粗利順で売上ABCと同様に
※最後は売上順で

解答

Sub ノック88本目()
    Dim wsABC As Worksheet: Set wsABC = Sheets("クロスABC")
    Dim wsマスタ As Worksheet: Set wsマスタ = Sheets("商品マスタ")
    Dim wsデータ As Worksheet: Set wsデータ = Sheets("data")
    Dim lastrow As Long: lastrow = wsデータ.Cells(Rows.Count, 1).End(xlUp).Row
'元のデータ削除
    With wsABC
        .Range("A1").CurrentRegion.Offset(1).ClearContents
    'データ転記
        wsデータ.Range("A2:A" & lastrow).Copy Destination:=.Range("A2")
        wsデータ.Range("B2:B" & lastrow).Copy Destination:=.Range("C2")
    'マスタから取得、計算
        .Range("B2:B" & lastrow).Formula = "=VLOOKUP($A2,商品マスタ!A:B,2,0)"
        .Range("D2:D" & lastrow).Formula = "=VLOOKUP($A2,商品マスタ!A:C,3,0)"
        .Range("E2:E" & lastrow).Formula = "=VLOOKUP($A2,商品マスタ!A:D,4,0)"
        .Range("F2:F" & lastrow).Formula = "=C2*D2"
        .Range("G2:G" & lastrow).Formula = "=C2*E2"
        .Range("H2:H" & lastrow).Formula = "=G2-F2"
        .Range("A2:H" & lastrow).Value = .Range("A2:H" & lastrow).Value '値に
        
        Call ABC(.Range("A2:J" & lastrow), 7, 9)   '売上ABC
        Call ABC(.Range("A2:J" & lastrow), 8, 10) '粗利ABC
        .Range("A2:J" & lastrow).Sort key1:=.Range("G2"), order1:=xlDescending, Header:=xlNo
    End With
    
End Sub

Sub ABC(全体の範囲 As Range, 並び替えたい列 As Long, 結果を出したい列 As Long)
'並び替える
    全体の範囲.Sort key1:=全体の範囲.Cells(1, 並び替えたい列), order1:=xlDescending, Header:=xlNo

    Dim i As Long, total As Long, subtotal As Long
    total = WorksheetFunction.Sum(全体の範囲.Columns(並び替えたい列))
    subtotal = 0
'最終行までループ
    For i = 1 To 全体の範囲.Rows.Count
        subtotal = subtotal + 全体の範囲.Cells(i, 並び替えたい列)
        Select Case subtotal / total
            Case Is <= 0.5
                全体の範囲.Cells(i, 結果を出したい列) = "A"
            Case Is <= 0.9
                全体の範囲.Cells(i, 結果を出したい列) = "B"
            Case Else
                全体の範囲.Cells(i, 結果を出したい列) = "C"
        End Select
    Next i

End Sub

■考え方・流れ
0:00 冒頭・問題確認
2:46 dataシートから転記する　
5:04 商品マスタシートから項目を取得
7:02 ABCを求めるSubプロシージャの作成
9:02 Sub ABCに値をぶち込む
11:14 合計に対する割合でABCの分岐
14:08 最後の仕上げと注意点

かなりゴリ押しなコードでの解説となっております！

新人君

ホントはEnum(列挙型)を使うと
もっとすっきりしたコードに
なりましたかね！

ブチョ

い、いーにゅーむ？
えーぬむ？

新人君

うん。どっちも違う…

dataシートから転記する

シートを定義したり、最終行を取得したり…。
この辺りはサクッと？？進めましょう…

使うシートは三つ！

最終行をlastrowって変数にしちゃいます！

ま、これは正直難しくない…。

この辺までは基本のき！

商品マスタシートから項目を取得

これも別シートから情報を持ってきてるだけでござんす。

掛け算とか引き算って言葉使ってるのが小学生感あるよね。
さすがuぷ主。

まずはシートに関数を書いて、そこからVBAにコピペしたら簡単かな！

他の列も一緒！

んー！なんてダラダラとしたコードなんだろうか…

ま、とりあえずこれで必要なデータが1シートにまとまった！

ABCを求めるSubプロシージャの作成

今回は、売上、粗利、二つの項目のABCの評価を出したい…
どちらもやることはおんなじだけど使う列と出力する列だけが違う…
そんな時は…同じコードを2回書くよりは一つのプロシージャにして使いまわす方がよいかな？

方法はこんな感じ↓

J列もやることは一緒だね！

これらを加味すると…必要な情報は…

こんな感じだケロ～！

作ったプロシージャに値をぶち込む

Callステートメントで別プロシージャを呼び出せたよね！

全体の範囲と、並び替えたい列番号と、結果を出したい列番号を与えてあげる！

あとは全体の範囲を、並び替え……

降順は、order1をxlDescendingにすりゃーOK

一番上のセルを含める場合はxlNoを、含めない場合はxlYesにすりゃいいぜよ

一旦ここまで～

合計に対する割合でABCの分岐

並び替えまで出来たら、ここからは結果を出したい列に、ABCどれになるかを出力！
こいつはSubtotal関数的なことをすりゃーOKですかねぇ

この辺は A = A + 1 的な構文が理解出来てたら大丈夫かな？

こんな感じで、Subtotalの結果が0.5以下、0.9以下、その他によって分岐してあげればOK

F8でゆっくり実行すると…

Good！あと少しで完成！

最後の仕上げと注意点

仕上げ～～！
I列に対してやったことを、J列にやればいいだけなんだけど…

行数を変えりゃいいだけんぬ！！

これで終わってもいいけど…
一応、再実行を考慮したり…

withステートメントさんでくくってあげて、完成！！

ここからは補足！！
今回、こういうダラダラなコードを書いちゃったけど…

実はEnumってのを使うと、もっときれいにまとめられたらしいんですわ！(知らんけど)

よかったらこっちも見てみてね！

ブチョ

お疲れ様！
頑張ったね！

新人君

あざます！

あとがたり

おはこんばんちは。uぷ主です。
88本目、クロスABC分析表を作成する問題でした。

今回は使うシートも多いので、コードをまとめるのが大変でした…(まとまってない)
模範解答を見た時…、Enumって知ってはいたんですが使ったことなかったんですよねw
なので、「うわぁ～！こういう時に使うんか～！」って感動しました！

実務でこれ使ってた方がよかった場面、めちゃめちゃあった気がする。
今すぐすぐは使わんけど、使いてぇ～！

2周目(ここまで届く可能性はかなり低いが…)ではEnumを使って解きたい問題！

はい。とまあそんな感じで、今回も楽しかった～！

神髄さん！ありがとうございましたぁぁあああ！！

そして最後までご視聴いただいたみなさん！ありがとうございました！！感謝！

P.S.皆さん…体調にはお気をつけて…
実はこの度新型○○に感染し…死ぬほどきつかった～～～～。