BDAstyle

ビジネスデータ分析ツールの作成 with Excel

クロスABC分析 with Excel VBA(ver.2010 or later)

1.アウトライン

クロスABC分析は「売上金額」と「販売数量」ないし「売上金額」と「粗利額」,あるいは「売上金額」と「得意先数」など,内容の異なる 2 変数について注目する複合的な視点からのABC分析手法です。1変数のABC分析と比べればセグメントの数が3倍となる意味において,より細かな区分をなすことが可能です。

しかし,クロスABC分析の成果物である分析表をエクセルで作成するまでには,一般には煩雑な手続きが必要となります(ピボットテーブルではセグメントの内容について一覧性のある表をダイレクトに作成できません)。このマクロはその手間を軽減する趣旨のものです(バージョン2010以降にのみ対応しています。またコードの冗長性排除・エラー対策等は施してありません)。

またこのマクロは,リスト形式表をピボット表で集計し,そのデータをもとにして分析表を作成する…といった流れを想定して作成しています。ただ,ピボットテーブルを利用しない場合でも,step 6と同一の構成で,項目列・第1変数の構成比・第2変数の構成比となる元表を用意して対応は可能です(すべての同じ要素をA3のセルを基点に配置)。

初期データ

(※表の見方についてはページ最下部を参照ください)

免責および特記事項

2.クロスABC分析表の作成

Step 1ピボット表の作成(1)

データ領域の任意のセルをアクティブにして 挿入タブ「テーブル」グループのピボットテーブルボタンをクリックします。

Step 2ピボット表の作成(2)

「ピボットテーブルの作成」ダイアログが表示されます。対象範囲と ピボットテーブルを配置する場所が「新規ワークシート」になっていることを確認して,OKボタンをクリックします。

Step 3ピボット表の作成(3)

あたらしいシートにピボット表が作成されます。

ここでは,ABC分析の視点として

・売上金額(以下「第1変数」)

・販売数量(以下「第2変数」)

に注目するものと仮定します。

…ということで,フィールドリストから,「商品名」(項目として使用したい変数)を「行ラベル」枠内に,「単価」(第1変数)と「商品名」(第2変数)を「値」枠内にドラッグ&ドロップします。

Step 4ピボット表の作成(4)

「値」枠の2変数を構成比に変更します。

まず,この枠の「合計/単価」をクリックし,ポップアップメニューから「値フィールドの設定」をクリックします。

Step 5ピボット表の作成(5)

「値フィールドの設定」ダイアログが表示されます。

計算の種類タブに切り替え,計算の種類から「列集計に対する比率」を選択します。

「値」枠内のもう一方の変数も同様に設定して構成比へ変更します。

Step 6ピボット表の作成(6)

ピボット表の各変数の見出しを適切なものに書き換えます。ここで指定したものが目的の分析表に表示されます。

Step 7VBE(Visual Basic Editor)の起動(1)

次に,開発タブ「コード」グループのVisual Basicボタンをクリックします。

Step 8VBE(Visual Basic Editor)の起動(2)

VBEが起動しました。

Step 9VBEの操作・VBAコードの導入(1)

VBE挿入メニュー標準モジュールをクリックします。

Step 10VBEの操作・VBAコードの導入(2) 「標準モジュール」ウインドウ

「標準モジュール」ウインドウが表示されました。

Step 11VBEの操作・VBAコードの導入(3) コードのコピー

次のコードをすべて選択し,コピーします。

Sub CROSSABCanalysis()

' *** クロスABC分析表の作成 ver.1.1.0
' *** 「クロスABC分析表の作成 with Excel」で掲載する形式で,
' *** 2変数によるピボット表をもとにクロスABC分析表を作成するマクロです。
' *** 元表は掲載の表と同じ体裁を整えている必要があります。
' *** 詳細は当該ページ(http://bdastyle.net/tools/abc-analysis/page3.html)をご覧ください。
' *** BDAstyle(http://bdastyle.net/)
' *** by hawcas 2013, 2016

On Error GoTo myError

' ※※※ AB境界, BC境界初期値
Const A1limit As Double = 0.7  ' ABクラス境界(1番目の変数)
Const B1limit As Double = 0.9  ' BCクラス境界(1番目の変数)
Const A2limit As Double = 0.7  ' ABクラス境界(2番目の変数)
Const B2limit As Double = 0.9  ' BCクラス境界(2番目の変数)
' ※※※

Dim BR As Long ' ピボット表の見出し込みの項目数を格納
Dim NoI(3, 3) As Long ' 象限(x, y)の内包する項目の数
Dim MNiR(3) As Long ' 各行の項目数のMax値
Dim EV(2) As Long ' ABC評価(変数1・変数2)
Dim cellX As Long ' 配列番号(X)
Dim cellY As Long ' 配列番号(Y)
Dim xSeries() As Variant ' データ格納用の配列
Dim CR As Variant ' 累積比率
Dim BA As String ' Range
Dim xRng As String ' Range
Dim xCtr(3, 3) As Long ' 以下カウンタ
Dim x As Long, y As Long, z As Long

' ピボット表よりデータを読み込み
BR = ActiveSheet.Range("a3").End(xlDown).Row - 3
ReDim xSeries(3, BR)
For x = 1 To 3
    For y = 1 To BR
        xSeries(x, y) = Range("a3").Offset(y - 1, x - 1).Value
    Next
Next

' シートの追加
Worksheets.Add

' データを転記
For x = 1 To 3
    For y = 1 To BR
        Range("a1").Offset(y - 1, x - 1).Value = xSeries(x, y)
    Next
Next
Range("d1").Value = "CR1" ' 見出しを追加
Range("e1").Value = "CR2"
Range("f1").Value = "EV1"
Range("g1").Value = "EV2"

' [変数2]ソートと累積比率の計算
xRng = "$a$1:$g$" & BR
Range(xRng).Sort key1:=Range("c1"), order1:=xlDescending, Header:=xlYes
CR = 0
For y = 1 To BR - 1
    CR = CR + Range("c1").Offset(y, 0).Value
    Range("e1").Offset(y, 0).Value = CR
Next

' [変数2]評価(1=A, 2=B, 3=C)
For y = 1 To BR - 1
    If Range("e1").Offset(y, 0).Value < A2limit Then
        Range("g1").Offset(y, 0).Value = 1
    ElseIf Range("e1").Offset(y, 0).Value < B2limit Then
        Range("g1").Offset(y, 0).Value = 2
    Else
        Range("g1").Offset(y, 0).Value = 3
    End If
Next

' [変数1]ソートと累積比率の計算
Range(xRng).Sort key1:=Range("b1"), order1:=xlDescending, Header:=xlYes
CR = 0
For y = 1 To BR - 1
    CR = CR + Range("b1").Offset(y, 0).Value
    Range("d1").Offset(y, 0).Value = CR
Next

' [変数1]評価(1=A, 2=B, 3=C)
For y = 1 To BR - 1
    If Range("d1").Offset(y, 0).Value < A1limit Then
        Range("f1").Offset(y, 0).Value = 1
    ElseIf Range("d1").Offset(y, 0).Value < B1limit Then
        Range("f1").Offset(y, 0).Value = 2
    Else
        Range("f1").Offset(y, 0).Value = 3
    End If
    
' 象限ごとに項目数をカウント
    cellY = Range("f1").Offset(y, 0).Value
    cellX = Range("g1").Offset(y, 0).Value
    NoI(cellY, cellX) = NoI(cellY, cellX) + 1
Next

' 行ごとに列を探索して最大の項目数を取得
With Application.WorksheetFunction
    MNiR(1) = .Max(NoI(1, 1), NoI(1, 2), NoI(1, 3))
    MNiR(2) = .Max(NoI(2, 1), NoI(2, 2), NoI(2, 3))
    MNiR(3) = .Max(NoI(3, 1), NoI(3, 2), NoI(3, 3))
End With
    
' 9つの象限へ項目を振り分け
For y = 1 To BR - 1
    EV(1) = Range("f1").Offset(y, 0).Value
    EV(2) = Range("g1").Offset(y, 0).Value
    Select Case EV(1)
    Case 1
        Select Case EV(2)
        Case 1
            BA = Range("k3").Address
        Case 2
            BA = Range("k3").Offset(0, 3).Address
        Case 3
            BA = Range("k3").Offset(0, 6).Address
        End Select
    Case 2
        Select Case EV(2)
        Case 1
            BA = Range("k3").Offset(MNiR(1) + 1, 0).Address
        Case 2
            BA = Range("k3").Offset(MNiR(1) + 1, 3).Address
        Case 3
            BA = Range("k3").Offset(MNiR(1) + 1, 6).Address
        End Select
    Case 3
        Select Case EV(2)
        Case 1
            BA = Range("k3").Offset(MNiR(1) + MNiR(2) + 2, 0).Address
        Case 2
            BA = Range("k3").Offset(MNiR(1) + MNiR(2) + 2, 3).Address
        Case 3
            BA = Range("k3").Offset(MNiR(1) + MNiR(2) + 2, 6).Address
        End Select
    End Select
    xCtr(EV(1), EV(2)) = xCtr(EV(1), EV(2)) + 1
    Range(BA).Offset(xCtr(EV(1), EV(2)) - 1, 0).Value = Range("a1").Offset(y, 1).Value
    Range(BA).Offset(xCtr(EV(1), EV(2)) - 1, 1).Value = Range("a1").Offset(y, 0).Value
    Range(BA).Offset(xCtr(EV(1), EV(2)) - 1, 2).Value = Range("a1").Offset(y, 2).Value
Next

' 外周罫の描画
With Range(Range("i1").Address, Range("s1").Offset(MNiR(1) + MNiR(2) + MNiR(3) + 4, 0).Address)
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
End With

' 横罫の描画
With Range(Range("i1").Offset(1, 0).Address, Range("s1").Offset(1, 0).Address)
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
With Range(Range("i1").Offset(2, 0).Address, Range("s1").Offset(MNiR(1) + 2, 0).Address)
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
With Range(Range("i1").Offset(MNiR(1) + MNiR(2) + 3, 0).Address, Range("s1").Offset(MNiR(1) + MNiR(2) + 3, 0).Address)
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

' 縦罫の描画
With Range(Range("i1").Offset(0, 1).Address, Range("i1").Offset(MNiR(1) + MNiR(2) + MNiR(3) + 4, 1).Address)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
End With
With Range(Range("i1").Offset(0, 5).Address, Range("i1").Offset(MNiR(1) + MNiR(2) + MNiR(3) + 4, 7).Address)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
End With

' 表側頭罫線の削除
Range("$i$1:$j$2").Borders(xlInsideVertical).LineStyle = xlLineStyleNone
Range("$i$1:$j$2").Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone

' 変数1のデータバーをセット
z = MNiR(1) + MNiR(2) + MNiR(3) + 5
xRng = "$k$3:$k$" & z & ",$n$3:$n$" & z & ",$q$3:$q$" & z
With Range(xRng)
    .FormatConditions.AddDatabar
    .FormatConditions(.FormatConditions.Count).ShowValue = False
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
End With
With Range(xRng).FormatConditions(1)
    '.MinPoint.Modify newtype:=xlConditionValueAutomaticMin ' 最大構成比の項目=1とする場合
    '.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
     .MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 ' 全体=1とする場合
     .MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1
End With
With Range(xRng).FormatConditions(1).BarColor
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0.25
End With
With Range(xRng).FormatConditions(1)
    .BarFillType = xlDataBarFillSolid
    .Direction = xlRTL
    .BarBorder.Type = xlDataBarBorderNone
End With

' 変数2のデータバーをセット
xRng = "$m$3:$m$" & z & ",$p$3:$p$" & z & ",$s$3:$s$" & z
With Range(xRng)
    .FormatConditions.AddDatabar
    .FormatConditions(.FormatConditions.Count).ShowValue = False
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
End With
With Range(xRng).FormatConditions(1)
    '.MinPoint.Modify newtype:=xlConditionValueAutomaticMin ' 最大構成比の項目=1とする場合
    '.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
     .MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 ' 全体=1とする場合
     .MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1
End With
With Range(xRng).FormatConditions(1).BarColor
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.35
End With
With Range(xRng).FormatConditions(1)
    .BarFillType = xlDataBarFillSolid
    .Direction = xlLTR
    .BarBorder.Type = xlDataBarBorderNone
End With

' 項目部分の彩色
xRng = "$l$3:$l$" & z & ",$o$3:$o$" & z & ",$r$3:$r$" & z
With Range(xRng).Interior
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.05
End With

' 見出しの作成
xRng = "$i$3:$i$" & z
Range(xRng).MergeCells = True
With Range("i3")
    .Orientation = xlVertical
    .VerticalAlignment = xlTop
End With
Range("i3").Value = Range("b1").Value
Range("$k$1:$s$1").MergeCells = True
Range("k1").Value = Range("c1").Value
With Range("j2")
    .Offset(1, 0) = "A"
    .Offset(1 + MNiR(1) + 1, 0) = "B"
    .Offset(1 + MNiR(1) + MNiR(2) + 2, 0) = "C"
    .Offset(0, 1) = "A"
    .Offset(0, 4) = "B"
    .Offset(0, 7) = "C"
End With

' 目的の表以外の要素を削除
Columns("A:H").Delete

Exit Sub
    
myError:
   MsgBox "実行時エラーが発生しました。処理を終了します。"

End Sub

Step 12VBEの操作・VBAコードの導入(4) コードの貼り付け

「標準モジュール」ウインドウにコードを貼り付けます。

Step 13VBEの操作・VBAコードの導入(5) パラメータの設定

境界前後の項目の構成比などを勘案して(たとえば,同じ構成比なのにBCクラスに分かれることに意味があるか,など),必要に応じてABCクラス分けの境界(下のパレート図でいう「Axlimit」と「Bxlimit」)を変更します。

初期値は0.7(70%)AクラスとBクラスの境界に,0.9(90%)BクラスとCクラスの境界になっています。これを修正する場合,コードの先頭方向にある「※」で囲まれた定数の値を直接変更してください(小数表記で)。第1変数・第2変数と独立して指定できます。

参考)パレート図

Step 14VBEの操作・VBAコードの導入(6)

閉じるボタンをクリックしてVBEを閉じます。

Step 15マクロの実行(1) “CROSSABCanalysis”

マクロを実行する前にピボット表をアクティブな状態にしておきます

次に 開発タブ「コード」グループのマクロボタンをクリックします。

Step 16マクロの実行(2) “CROSSABCanalysis”

「マクロ」ダイアログが表示されます。

マクロ名に「CROSSABCanalysis」が表示されていることを確認して,実行ボタンをクリックします。

Step 17クロスABC分析表・完成

あたらしいシートが追加され,ピボット表をもとにしてクロスABC分析表が作成されます。

縦方向が第1変数,横方向が第2変数のABCクラスをあらわしています。各クラスには該当する項目(ここでは商品名)が自動的に振り分けられます。項目名の左側横棒線は,デフォルトでは第1変数のパレート図の棒部分,すなわち生起確率をあらわします(ただし,コードを変更すれば最も値の大きい項目=セルの列幅と定義する相対量によって各個の大きさをあらわすことも可能です。次に同じ)。同じく右側横棒線は第2変数のパレート図の棒をあらわします。項目は各クラスごとに第1変数の降順で並べられます。

書式等を任意に調整してクロスABC分析表の完成です。

その他の参照