見出し画像

VBA 商品番号の件数を支社毎にカウント

Sheet1"集計"

1行目が支社名、A列が商品番号

Sheet2"JA"

C列の商品名をSheet1、A列と比較し合致したら該当支社セルに値をカウントしていく。

コード

Sub 商品番号、支社毎カウント()
'Sheet1 集計
'Sheet2 データ
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim Scnt(3) As Long
    
    ' シートを指定
    Set ws1 = ThisWorkbook.Sheets("集計")
    Set ws2 = ThisWorkbook.Sheets("JA")
    
    ' Sheet2の最終行と列を取得
    Dim lastRow2 As Long
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    Dim lastCol2 As Long
    lastCol2 = ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
    
    Dim lastRow1 As Long
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    Dim lastCol1 As Long
    lastCol1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    
    ' 商品名をSheet1と比較し、Sheet1に結果を表示
    For i = 2 To lastRow1
        Scnt(1) = 0
        Scnt(2) = 0
        Scnt(3) = 0
        For j = 2 To lastRow2
            If ws2.Cells(k, 3).Value = ws1.Cells(i, 1).Value Then
                Select Case ws2.Cells(k, 1)
                    Case Is = "A"
                        Scnt(1) = Scnt(1) + 1
                        ws1.Cells(i, 2) = Scnt(1)
                    Case Is = "B"
                        Scnt(2) = Scnt(2) + 1
                        ws1.Cells(i, 3) = Scnt(2)
                    Case Is = "C"
                        Scnt(3) = Scnt(3) + 1
                        ws1.Cells(i, 4) = Scnt(3)
                End Select
            End If
        Next j
    Next i
End Sub

無駄にSheet1、2の最終列を取得してますがただのクセです。
もうちょっとスマートになると嬉しいな。。。



この記事が気に入ったらサポートをしてみませんか?