| 
    
     |  | ▼ひなぱぱ さん: こんばんは。
 
 >どなたか教えてください。その支店の月毎の売上数字を8:2分析(支店の売上の8割は2割の得意先で占めているという分析方法)をしたいと思いますが、どのようにマクロを組めばいいのか見当がつきません。教えてください。宜しくお願い致します。
 >
 >W支店の場合
 >
 >A社 売上 15,000-
 >B社 売上  3,000-
 >C社 売上 20,000-
 >D社 売上  1,000-
 >E社 売上  1,000-
 >
 >合計は40,000-ですので売上の8割は32,000-となり表により2社(A社とC社)による売上数字である。
 >この2社を抽出するか(別シートに)または、判別するか(*マークがつくとか)で、その支店の8割の売上を上げている2割の得意先を分析したいのです。
 >説明が至りませんで申し訳ございません。
 >宜しくお願い致します。
 方法は、いくつかあると思います。
 新規ブックにひなぱぱ さんがご提示されたような以下のようなデータを
 アクティブシートのA、B列の1行目から記述してみて下さい。
 
 A   B
 1 顧客名 売上
 2 A社  15000
 3 B社  3000
 4 C社  20000
 5 D社  1000
 6 E社  1000
 
 データを記述後、以下のコードを実行してみて下さい。
 尚、C,D,E列を作業列として使用しています。
 
 '====================================================
 Sub main()
 Dim rng As Range
 Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp))
 If rng.Row > 1 Then
 Range("c1:e1").Value = Array("Seq", "仮判定", "判定")
 With rng
 With .Offset(0, 2)
 .Formula = "=row()"
 .Value = .Value
 '      ↑売上の多い順に並べ替えを行うので
 '       元に戻すためのシーケンスナンバを付ける
 End With
 With .Offset(-1, 0).Resize(.Rows.Count + 1, 3)
 .Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
 :=xlPinYin
 End With
 '      ↑売上の大きい順に並べ替え
 .Offset(0, 3).Resize(, 2).Formula = _
 Array("=SUM($B$2:B2)<SUM(" & .Offset(0, 1).Address & ")*0.8", _
 "=IF(SUM($B$2:B2)<SUM(" & .Offset(0, 1).Address & ")*0.8,""*""," & _
 "IF(ROW()>2,IF(OFFSET(e2,-1,-1,1,1)=TRUE,""*"",""""),""""))")
 With .Offset(0, 3).Resize(, 2)
 .Value = .Value
 End With
 '     ↑D,E列に数式設定。売上の80%を満たす顧客に"*"マークを付ける
 With .Offset(-1, 0).Resize(.Rows.Count + 1, 5)
 .Sort Key1:=Range("c2"), Order1:=xlAscending, Header:=xlGuess, _
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
 :=xlPinYin
 End With
 '      ↑C列のシーケンスナンバで並べ替え(元に戻す)
 Columns("c:d").Delete
 '     ↑作業列 C,D列の削除
 End With
 End If
 End Sub
 
 確認してみて下さい。
 
 |  |