質問です

データSheet1には2行目からです。A列 日付、 B列 性別、 C列 金額
2011/5/1   男    10000
2011/5/1   男    -10000
2011/5/1   女     -5000
2011/5/2    男    20000 
2011/5/2   男    5000
2011/5/2   女    -3000   
エクセルで日付ごとに男女別に正数と負数の金額集計できる関数またはマクロをお願いします。
答えはSheet2に項目1行目、2行目にデータを一覧表で作成
正数のみの集計
A列     B列    C列    D列   E列     F列     G列    
日付     男人数   金額   女人数  金額   合計人数  合計金額
2011/5/1   1    10000     0    0       1    10000
2011/5/2   1    20000     1    5000     2    25000
負数のみの集計    
日付     男人数  金額    女人数    金額  合計人数  合計金額
2011/5/1   1   -10000      1     -5000   2    -15000
2011/5/2   0     0        1     -3000   1    -3000 

正負合計の集計     
項目は同じ

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/06/02 14:37:03
  • 終了:2011/06/04 21:51:20

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/06/02 16:21:51

ポイント100pt
Sub syukei()
    s1 = "Sheet1"
    s2 = "Sheet2"
    
    'Sheet2を初期化する。
    Sheets(s2).Cells.Delete Shift:=xlUp

    b = 1
    For df = 1 To 3
        For a = 2 To Sheets(s1).Range("A2").End(xlDown).Row
            If a = 2 Then
                Sheets(s2).Cells(b, "A") = "日付"
                Sheets(s2).Cells(b, "B") = "男人数"
                Sheets(s2).Cells(b, "C") = "金額"
                Sheets(s2).Cells(b, "D") = "女人数"
                Sheets(s2).Cells(b, "E") = "金額"
                Sheets(s2).Cells(b, "F") = "合計人数"
                Sheets(s2).Cells(b, "G") = "合計金額"
                b = b + 1
                c = b
            End If
            
            f = 0
            Select Case df
                Case 1
                    '正だったら オン
                    If Sheets(s1).Cells(a, "C") >= 0 Then
                        f = 1
                    End If
                Case 2
                    '負だったら オン
                    If Sheets(s1).Cells(a, "C") < 0 Then
                        f = 1
                    End If
                Case 3
                    f = 1
            End Select
            
            f2 = 0
            If f = 1 Then
                For g = c To b
                    If Sheets(s1).Cells(a, "A") = Sheets(s2).Cells(g, "A") Then
                        If Sheets(s1).Cells(a, "B") = "男" Then
                            Sheets(s2).Cells(g, "B") = Sheets(s2).Cells(g, "B") + 1
                            Sheets(s2).Cells(g, "C") = Sheets(s2).Cells(g, "C") + Sheets(s1).Cells(a, "C")
                        Else
                            Sheets(s2).Cells(g, "D") = Sheets(s2).Cells(g, "D") + 1
                            Sheets(s2).Cells(g, "E") = Sheets(s2).Cells(g, "E") + Sheets(s1).Cells(a, "C")
                        End If
                        Sheets(s2).Cells(g, "F") = Sheets(s2).Cells(g, "F") + 1
                        Sheets(s2).Cells(g, "G") = Sheets(s2).Cells(g, "G") + Sheets(s1).Cells(a, "C")
                        f2 = 1
                        Exit For
                    End If
                Next g
                
                If f2 = 0 Then
                        '新規追加
                        Sheets(s2).Cells(b, "A") = Sheets(s1).Cells(a, "A")
                        Sheets(s2).Cells(b, "A").NumberFormatLocal = Sheets(s1).Cells(a, "A").NumberFormatLocal
                        If Sheets(s1).Cells(a, "B") = "男" Then
                            Sheets(s2).Cells(b, "B") = 1
                            Sheets(s2).Cells(b, "C") = Sheets(s1).Cells(a, "C")
                            Sheets(s2).Cells(b, "D") = 0
                            Sheets(s2).Cells(b, "E") = 0
                        Else
                            Sheets(s2).Cells(b, "B") = 0
                            Sheets(s2).Cells(b, "C") = 0
                            Sheets(s2).Cells(b, "D") = 1
                            Sheets(s2).Cells(b, "E") = Sheets(s1).Cells(a, "C")
                        End If
                        Sheets(s2).Cells(b, "F") = 1
                        Sheets(s2).Cells(b, "G") = Sheets(s1).Cells(a, "C")
                        b = b + 1
                End If
            End If
        Next a
        b = b + 1
    Next df

End Sub

ちょっと間違えてたので修正しました。

  • id:inosisi4141
    takntさん
    ありがとうございます。
    質問がわかりにくかったかもしれません。
    日付ごとにまとめての人数計と金額計が男女別におよびその合計を表示する
    A列は1日から31日までのいづれかとなり重複日付はありません
  • id:taknt
    うまくいかないですか?
  • id:inosisi4141
    takntさん
    はい日付が1行づつになってしまいます1日が件数分ならんでしまいます
    1日が10件あればその10件を合計して件数と金額に男女別に表記できると
    良いのです。
  • id:taknt
    質問にある内容で やってみましたが その通りになりました。
    書式設定か何か違うものがあるのかもしれませんね。
  • id:taknt
    ただ 質問の結果って 違いますね。

    私のほうでは ↓になりました。
    日付 男人数 金額 女人数 金額 合計人数 合計金額
    2011/5/1 1 10000 0 0 1 10000
    2011/5/2 2 25000 0 0 2 25000

    日付 男人数 金額 女人数 金額 合計人数 合計金額
    2011/5/1 1 -10000 1 -5000 2 -15000
    2011/5/2 0 0 1 -3000 1 -3000

    日付 男人数 金額 女人数 金額 合計人数 合計金額
    2011/5/1 2 0 1 -5000 3 -5000
    2011/5/2 2 25000 1 -3000 3 22000

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません