[[20060729225711]]　『ランキング表の作成』（エクセル難）　ページの最後に飛ぶ

『ランキング表の作成』（エクセル難）

 こんばんわ。なれないエクセルに四苦八苦の毎日です。
仕事で全社員の個人経費の経費別使用金額ランキングを作成します。
表は以下のようになっています。

 部門　社員ＮＯ　氏名　経費項目　金額　使用日
 001　　123456　　田中　消耗品費　900　7月1日
 002　　987654　　鈴木　消耗品費　500　7月2日
 001　　123456　　田中　消耗品費　200　7月7日
 003　　123455　　佐藤　接待費　　500　7月5日
 006　　987655　　山田　接待費　　900　7月8日
 006　　987655　　山田　接待費　　800　7月8日
 ：
 ：
 ：（2000行程続く）

 これを下記のようにしたいのです。

 順位　部門　社員ＮＯ　氏名　経費項目　　金額　
　1　　001　　123456　　田中　消耗品費　1,100　
　2　　002　　987654　　鈴木　消耗品費　　500　
 －－－－－－－－－－－－－－－－－－－－－－
　　　　　　　　　　　　　　　合計　　　2,600

 順位　部門　社員ＮＯ　氏名　経費項目　　金額　
　1　　006　　987655　　山田　接待費　　1,700　
　2　　003　　123455　　佐藤　接待費　　　500　　
 －－－－－－－－－－－－－－－－－－－－－－
　　　　　　　　　　　　　　　合計　　　2,200
　　　
 一応自分では経費ごと社員ＮＯ別に「集計」をして
「ＶＬＯＯＫＵＰ」で社員ＮＯから氏名と部門を「検索」するような方法を
とろうと試みたのですが、検索がエラーになってしまいました。
 何かもっとうまくいく方法があれば、ぜひお力を貸してください。
お忙しいところ申し訳ございませんがよろしくお願いいたします。

 ---
 すみません、変な風にアップしてしまいました。
下記のとおり修正いたします。

 ---　整形したので以下省略 文の最初に半角スペースを入れるといいですよ　---　
      (かなれっと)

 これと同じですね
https://www.excel.studio-kazu.jp/cgi-bin/kazuwiki2.cgi?mycmd=read&mypage=[[20050820172108]]  (kym)

 ◆作業列による方法です
 ◆Sheet1
	A	B	C	D	E	F	G
1	部門	社員ＮＯ	氏名	経費項目	金額	使用日	
2	001	123456	田中	消耗品費	900	7月1日	0
3	002	987654	鈴木	消耗品費	500	7月2日	0
4	001	123456	田中	消耗品費	200	7月7日	0
5	003	123455	佐藤	接待費	500	7月5日	500
6	006	987655	山田	接待費	900	7月8日	1700
7	006	987655	山田	接待費	800	7月8日	0

 ◆Sheet2
	A	B	C	D	E	F
1	接待費				合計	2200
2	順位	部門	社員ＮＯ	氏名	経費項目	金額
3	1	006	987655	山田	接待費	1700
4	2	003	123455	佐藤	接待費	500

 ◆Sheet2のA1に、経費項目を入力してください（入力規則でリストから入力するようにしてはいかがでしょうか）
 ◆合計の位置も変更しました

 ◆Sheet1の作業列の式
 G2=IF(AND(D2=Sheet2!$A$1,COUNTIF($C$2:C2,C2)=1),SUMPRODUCT(($B$2:$B$100=B2)*($D$2:$D$100=Sheet2!$A$1)*$E$2:$E$100),0)
 ★下にコピー

 ◆Sheet2の式
 F3=IF(ROW(A1)>COUNTIF(Sheet1!G:G,">0"),"",LARGE(INDEX((Sheet1!$D$2:$D$100=$A$1)*Sheet1!$G$2:$G$100,),ROW(A1)))
 ★下にコピー

 B3=IF($F3="","",INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$G$2:$G$100=$F3)*ROW(Sheet1!$G$2:$G$100),),COUNTIF($F$3:$F3,$F3))))
 ★右・下にコピー

 E3=IF(F3="","",$A$1)
 ★右・下にコピー

 ◆回答は、「接待費」の例ですが、Sheet2のA1を変更すれば、その経費項目のデータが表示されます
 (Maron)

 マクロでやっつける方法です。
もとの表はSheet1に、出力される表はSheet2として作成しています。
使い方は、Alt+F11を押して、挿入-->標準モジュールを選択。
出てきた画面に下記コードを貼り付けてその画面を閉じる。
Alt+F8を押して、TESTを実行し、接待費とか消耗品費と入力する。
(ROUGE)
'----
Sub TEST()
    Dim dic As Object, i As Long, itm As Double, tbl, x As String
    Application.ScreenUpdating = False
    tbl = Worksheets("Sheet1").Range("A1").CurrentRegion.Resize(, 5)
    Set dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To UBound(tbl, 1)
        dic.Add tbl(i, 4), Empty
    Next
    On Error GoTo 0
    x = Application.InputBox("項目を入力して下さい", Type:=2)
    If Not dic.Exists(x) Then: MsgBox "項目がありません": Exit Sub
    dic.RemoveAll
    For i = 2 To UBound(tbl, 1)
        If tbl(i, 4) = x Then
            If Not dic.Exists(tbl(i, 2)) Then
                dic.Add tbl(i, 2), Array(tbl(i, 1), tbl(i, 2), _
                tbl(i, 3), tbl(i, 4), tbl(i, 5))
            Else
                itm = dic(tbl(i, 2))(4)
                itm = itm + tbl(i, 5)
                dic(tbl(i, 2)) = Array(tbl(i, 1), tbl(i, 2), _
                tbl(i, 3), tbl(i, 4), itm)
            End If
        End If
    Next
    With Worksheets("Sheet2")
        .Columns("A:F").ClearContents
        .Range("B1:F1").Value = Worksheets("Sheet1").Range("A1:E1").Value
        .Range("B2").Resize(dic.Count, 5).Value = Application.Transpose _
        (Application.Transpose(dic.Items))
        .Range("B1").CurrentRegion.Sort key1:=Range("F1"), _
        order1:=xlDescending, header:=xlYes, sortmethod:=xlPinYin
        .Range("A1").Value = "順位"
        .Columns("B").NumberFormatLocal = "000"
        i = .Range("B" & Rows.Count).End(xlUp).Row
        With .Range("A2:A" & i)
            .Formula = "=Row()-1"
            .Value = .Value
        End With
        .Range("E" & i + 1).Value = "合計"
        .Range("F" & i + 1).Value = WorksheetFunction.Sum(.Range("F2:F" & i))
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

 kym様、Maron様、ROUGE様ありがとうございました！
 Maron様のでなんとかがんばってみます。
 かなれっと様キレイにしてもらってすみませんです。(エクセル難）

コメント返信：

[ 一覧(最新更新順) ]

[[20060729225711]] 『ランキング表の作成』（エクセル難） ページの最後に飛ぶ

[[20060729225711]]　『ランキング表の作成』（エクセル難）　ページの最後に飛ぶ