ランキング表の作成方法

質問

ランキング表を作成しています。
Aの行には名前　Bの行には杯数　Cの行には単価　Dの行には杯数×単価＝合計金額
これを店舗別に5つのシートに分けて作成しています。

※例ですが、画像を添付しました。

最終的に別のシートに全店舗でのランキングを作成したいと思っています。
マクロなどで組む方法があれば教えて頂きたいです。

宜しくお願い致します。

回答No.4

tom04

No.3です！

投稿後に思ったのですが・・・
欲を言えばSheet6に列を増やして店舗名を入れた方が良いような気がします。

Sheet6を↓の画像のような配置にやり替えてみました。
当然コードも変わってきます。
前回のコードはすべて消して、↓のコードにしてみてください。
（B列はSheet1～Sheet5のSheet名を表示しています）

Sub Sample2() 'この行から
Dim i As Long, k As Long, startRow As Long, endRow As Long, wS6 As Worksheet
Set wS6 = Worksheets("Sheet6") '←Sheet6は実際のSheet名に！

endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 1 Then
Range(wS6.Cells(2, "A"), wS6.Cells(endRow, "D")).ClearContents
End If
For k = 1 To 5
With Worksheets(k)
.Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "A"), .Cells(endRow, "A")).Copy wS6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
.ShowAllData
startRow = wS6.Cells(Rows.Count, "B").End(xlUp).Row + 1
endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS6.Cells(startRow, "B"), wS6.Cells(endRow, "B")) = .Name
For i = startRow To endRow
wS6.Cells(i, "C") = WorksheetFunction.SumIf(.Range("A:A"), wS6.Cells(i, "A"), .Range("D:D"))
Next i
End With
Next k
wS6.Range("A1").CurrentRegion.Sort key1:=wS6.Range("C1"), order1:=xlDescending, Header:=xlYes
endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS6.Cells(2, "D"), wS6.Cells(endRow, "D"))
.Formula = "=RANK(C2,C:C)"
.Value = .Value
End With
End Sub 'この行まで

※　個人的にはこの方が良いと思います。m(_ _)m

回答No.3

tom04

こんばんは！
VBAでの一例です。

↓の画像のように左側がSheet1～Sheet5の配置で、右側がSheet6の配置とします。
すべてのSheetの1行目項目は入力済みだとします。

＞最終的に別のシートに全店舗でのランキングを作成したいと思っています
というコトですので、各Sheetの合計金額でのランキングとしています。

尚、各Sheetに同姓同名はないという前提です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペースト　→　Excel画面に戻ってマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, k As Long, startRow As Long, endRow As Long, wS6 As Worksheet
Set wS6 = Worksheets("Sheet6") '←Sheet6は実際のSheet名に！

endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 1 Then
Range(wS6.Cells(2, "A"), wS6.Cells(endRow, "D")).ClearContents
End If
For k = 1 To 5
With Worksheets(k)
.Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "A"), .Cells(endRow, "A")).Copy wS6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
.ShowAllData
startRow = wS6.Cells(Rows.Count, "B").End(xlUp).Row + 1
endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
For i = startRow To endRow
wS6.Cells(i, "B") = WorksheetFunction.SumIf(.Range("A:A"), wS6.Cells(i, "A"), .Range("D:D"))
Next i
End With
Next k
wS6.Range("A1").CurrentRegion.Sort key1:=wS6.Range("B1"), order1:=xlDescending, Header:=xlYes
endRow = wS6.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS6.Cells(2, "C"), wS6.Cells(endRow, "C"))
.Formula = "=RANK(B2,B:B)"
.Value = .Value
End With
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

回答No.2

chayamati

新しいシートに
A1:名前、B1:合計金額、C1：ランク
A2以下に名前を記入し

B2=SUMIF(Sheet1!$A$2:$D$10,A2,Sheet1!$D$2:$D$9)
C2=RANK.EQ(B2,$B$2:$B$4,0)

として縦にコピペします。
ここで、sheet2にも同一人がいるときは
B2=SUMIF(Sheet1!$A$2:$D$10,A2,Sheet1!$D$2:$D$9)
+SUMIF(Sheet2!$A$2:$D$10,A2,Sheet2!$D$2:$D$9)

回答No.1

keithin

＞最終的に別のシートに全店舗でのランキングを作成したい

具体的に何を集計したいのかご相談で書かれていませんが，ふつーに考えると
１）「りさ」や「あゆ」が売り上げた合計金額の総合計を集計したい
２）「りさ」や「あゆ」が売り上げた杯数の総合計を集計したい
といったところでしょうか。

手順：
新しい集計用のシートを１枚用意する
データタブの「統合」を開始する
各シートのＡ：Ｄ列を選んで追加していく
「左端列」「上端行」にチェックし，合計を選んで集計する

以上で
・店舗名一覧の自動書き出し
・各店舗毎の「杯数」「単価」「合計金額」の集計
が自動で得られます。
単価の合計列は不要なので削除します。

もし必要なら，更に手で「金額÷杯数」の計算式を書き出して，平均単価を求めて下さい。
更に「ランキング」が必要なら，統合結果をふつーに降順で並べ替えたり，必要に応じてRANK関数の列を追加して順位を計算して下さい。