HOME > Q&A > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録（無料）が必要です。会員登録がまだの方はこちら
  • 「掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Microsoft 365)
担当者毎集計について
投稿日時: 23/04/28 16:16:21
投稿者: wa_ko

下の表から担当者毎に〇、◎、●の数を集計したいです。
 
例
　　　１日　２日　３日　４日　５日　６日 ....
佐藤　〇　　　　　　◎　　〇　　
鈴木　　　　●　　　●　　
佐藤　●　　　　　　〇　　　　〇
山田　　　　◎　　　　　　　　◎
加藤　◎　　　　　　〇
鈴木　　　　◎　　　　　　◎
鈴木　●　　　　　　　　　●　●
 
 
〇、◎、●の全体数CountIfで集計できましたが、これを担当者毎に集計する方法が分からなくて困っています。
 
For i = 8 To cmax1
For j = 6 To 12
  Select Case Range("E" & i).Value
    Case "佐藤"
     If Cells(i, j).Value = "○" Then
    aCount = aCount + 1
　　　elseIf Cells(i, j).Value = "◎" Then
    bCount = bCount + 1
　　　elseIf Cells(i, j).Value = "●" Then
    cCount = cCount + 1
    Case "鈴木"
      If Cells(i, j).Value = "○" Then
    dCount = aCount + 1
　　　elseIf Cells(i, j).Value = "◎" Then
    eCount = bCount + 1
　　　elseIf Cells(i, j).Value = "●" Then
    fCount = cCount + 1
    Case "山田"
           If Cells(i, j).Value = "○" Then
    gCount = aCount + 1
　　　elseIf Cells(i, j).Value = "◎" Then
    hCount = bCount + 1
　　　elseIf Cells(i, j).Value = "●" Then
    iCount = cCount + 1
    Case "加藤"
          If Cells(i, j).Value = "○" Then
    jCount = aCount + 1
　　　elseIf Cells(i, j).Value = "◎" Then
    kCount = bCount + 1
　　　elseIf Cells(i, j).Value = "●" Then
    lCount = cCount + 1
 
  End Select
ちょっと変数定義端折っていますが、イメージ的にはfor文とcase文なのかなと思っていますが、ちょっとわからなくなっています…
どうぞよろしくお願い致します。

回答
投稿日時: 23/04/28 17:08:19
投稿者: WinArrow

担当者が増減に伴いコードを変更しなければならなくなるので、
２次元配列を利用することをお勧めします。
 
 
集計結果をどこに出力するかが説明されていないが、
 
縦方向に担当者
横方向に○●◎等記号
の表を作成し、
その表にカウントした値を埋込む方法を検討しましょう。
 
横方向にもCOUNTIF関数は使えますよ。
 
 
回答
投稿日時: 23/04/28 18:20:29
投稿者: WinArrow

担当者が重複しているが、
同じ名前の担当者は、どうするのですか？
回答
投稿日時: 23/04/28 18:58:14
投稿者: ロビンマスク

Sub Test()
    Dim Tantou(0 To 6, 0 To 3) As Variant
    Dim Index As Long
    Dim RowIndex As Long
    Dim CellRange As String
     
    '担当者開始行(２行目開始でテストしてます。)
    RowIndex = 2
     
    '担当者の行数分(7行分でテストしてます。)
    For Index = 0 To 6
        Tantou(Index, 0) = Sheets("Sheet1").Cells(RowIndex, 1).Value '担当者名
         
        'セル範囲の設定(例)1日〜31日設定で(B2:AF2)
        CellRange = "B" & RowIndex & ":AF" & RowIndex
         
        'CounIfで取得　CountIf(セル範囲, 条件)
        Tantou(Index, 1) = WorksheetFunction.CountIf(Range(CellRange), "〇") '〇の数
        Tantou(Index, 2) = WorksheetFunction.CountIf(Range(CellRange), "◎") '◎の数
        Tantou(Index, 3) = WorksheetFunction.CountIf(Range(CellRange), "●") '●の数
         
        RowIndex = RowIndex + 1
    Next Index
    
End Sub
回答
投稿日時: 23/04/28 20:00:14
投稿者: ロビンマスク

例
　　　１日　２日　３日　４日　５日　....３１日　〇の数　◎の数　●の数
佐藤　〇　　　　　　◎　　〇　　　　　　　　　　　※1　　※２　　※３
鈴木　　　　●　　　●　　
佐藤　●　　　　　　〇　　　　〇
山田　　　　◎　　　　　　　　◎
加藤　◎　　　　　　〇
鈴木　　　　◎　　　　　　◎
鈴木　●　　　　　　　　　●　●
 
 
※１に= COUNTIF(B2:AF2,"〇")
※２に= COUNTIF(B2:AF2,"◎")
※２に= COUNTIF(B2:AF2,"●")
 
これではだめですか？
回答
投稿日時: 23/04/28 20:57:16
投稿者: WinArrow

Sheets(1)から、Sheets(2)に、集計表を作成します。
 
一般機能でもできますよ!
(1)Sheets(2)の列Ａに担当者を複写して、重複を削除します。
(2)Sheets(2)のＢ１，Ｃ１，Ｄ１に○、◎、●を入力します。
※掲示の表の「まる」漢数字が使われているので、記号の「まる」に統一しましょう。
 
(3)Sheets(2)のB2セルに
=SUMPRODUCT((Sheet1!$A$2:$A$10=$A2)*(Sheet1!$B$2:$AF$10=B$1))
下へ、右へフィルドラッグします。
 
※行数、セル位置は、実態に合わせて変更してください。

回答
投稿日時: 23/04/28 21:50:56
投稿者: simple

ご指摘のとおり、ワークシート関数でできると思います。
VBAの学習目的と見なして、作成してみました。参考にしてみてください。
 

   A列   B     C     D     E     F    G     H     I     J     K
1行
2  佐藤  〇          ◎    〇                      〇    ◎    ●
3  鈴木        ●    ●                      佐藤  4     1     1
4  佐藤  ●          〇          〇          鈴木  0     2     5
5  山田        ◎                ◎          山田  0     2     0
6  加藤  ◎          〇                      加藤  1     1     0
7  鈴木        ◎          ◎                                  
8  鈴木  ●                ●    ●

 
Sub test()
    Dim mat(1 To 4, 1 To 3) As Long     '4人、３項目は予め判明しているものとした
    Dim i As Long, j As Long, p As Long
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Select Case Cells(i, "A")
            Case "佐藤": p = 1
            Case "鈴木": p = 2
            Case "山田": p = 3
            Case "加藤": p = 4
        End Select
        For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
            Select Case Cells(i, j).Value
                Case "〇": mat(p, 1) = mat(p, 1) + 1
                Case "◎": mat(p, 2) = mat(p, 2) + 1
                Case "●": mat(p, 3) = mat(p, 3) + 1
            End Select
        Next
    Next
    Range("I3").Resize(UBound(mat, 1), UBound(mat, 2)) = mat
End Sub
回答
投稿日時: 23/04/29 08:29:18
投稿者: simple

うーむ、
For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
これはおかしかった。
１行目に日付があるなら、１行目の最終列をとるか、
For j = 2 To Cells(i, Columns.Count).End(xlToLeft).Column
と各行の最終列をとらねばならなかったですね。

トピックに返信