【VBA】項目ごとのカウントを行う

VBAでシート上の項目ごとのデータ数のカウントを行うには、Dictionaryオブジェクトを使用すると
簡単に項目のカウントを行うことができます。

シートのA列に4種類の食べ物を入力しました。入力した食べ物を種類ごとにカウントしてみます。

Dictionaryオブジェクトを使用するのでMicrosoft Scripting Runtimeに参照設定を行う必要があります。

VBAに標準で含まれていない機能があるときは外部のライブラリを参照して、外部ライブラリ内の機能を利用します。この外部ライブラリの機能を利用する設定を、参照設定と言います。

シート上の項目のカウントを行うコードは以下になります。

Option Explicit

Public Sub CountItem(sht As Worksheet, col As Long)
'###################################################################################
'シート上の項目のカウントを行い、メッセージボックスに表示する
'Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要
'-----------------------------------------------------------------------------------
'引数  :sht 項目のカウントを行いたいシート
'      :col 項目のカウントを行いたい列番号
'###################################################################################
  
  Dim lastRow As Long
  lastRow = GetMaxRow(sht, col)
  
  Dim dic As Dictionary
  Set dic = New Dictionary
  Dim i As Long
  Dim v As String
  For i = 1 To lastRow
    v = sht.Cells(i, 1)
    If dic.Exists(v) Then
      dic(v) = dic(v) + 1
    Else
      dic.Add v, 1
    End If
  Next i
  
  For i = 0 To dic.Count - 1
    MsgBox dic.Keys(i) & "は" & dic.Items(i) & "個"
  Next i
  
  Set dic = Nothing

End Sub

Private Function GetMaxRow(sht As Worksheet, check_col As Long) As Long

  Dim lastRow As Long
  lastRow = sht.UsedRange.Row + sht.UsedRange.Rows.Count - 1
  GetMaxRow = 0
    
  Dim readRow As Long
  For readRow = lastRow To 1 Step -1
    If sht.Cells(readRow, check_col).Value <> "" Then
      GetMaxRow = readRow
      Exit For
    End If
  Next

End Function

Public Sub TestCountItem()
  
  Dim sht As Worksheet
  Set sht = ThisWorkbook.Worksheets("Sheet1")
  
  Call CountItem(sht, 1)
  
  Set sht = Nothing
  
End Sub

Option Explicit

Public Sub CountItem(sht As Worksheet, col As Long)

'###################################################################################

'シート上の項目のカウントを行い、メッセージボックスに表示する

'Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要

'-----------------------------------------------------------------------------------

'引数 :sht 項目のカウントを行いたいシート

' :col 項目のカウントを行いたい列番号

'###################################################################################

Dim lastRow As Long

lastRow = GetMaxRow(sht, col)

Dim dic As Dictionary

Set dic = New Dictionary

Dim i As Long

Dim v As String

For i = 1 To lastRow

v = sht.Cells(i, 1)

If dic.Exists(v) Then

dic(v) = dic(v) + 1

Else

dic.Add v, 1

End If

Next i

For i = 0 To dic.Count - 1

MsgBox dic.Keys(i) & "は" & dic.Items(i) & "個"

Next i

Set dic = Nothing

End Sub

Private Function GetMaxRow(sht As Worksheet, check_col As Long) As Long

Dim lastRow As Long

lastRow = sht.UsedRange.Row + sht.UsedRange.Rows.Count - 1

GetMaxRow = 0

Dim readRow As Long

For readRow = lastRow To 1 Step -1

If sht.Cells(readRow, check_col).Value <> "" Then

GetMaxRow = readRow

Exit For

End If

End Function

Public Sub TestCountItem()

Dim sht As Worksheet

Set sht = ThisWorkbook.Worksheets("Sheet1")

Call CountItem(sht, 1)

Set sht = Nothing

End Sub

TestCountItemを実行すると、シートのA列の項目のカウントを行います。
入力されている食べ物のそれぞれの個数がメッセージボックスに表示されます。

りんごは4個
レタスは3個
牛肉は2個
水は1個

りんごは4個

レタスは3個

牛肉は2個

水は1個

データの最終行を取得するためにコード内でGetMaxRowを使用しています。
GetMaxRowについては以下の記事をご覧ください。

【VBA】最終行と最終列を取得する

for文などで1行目から最終行、または1列目から最終列まで連続して処理を行いたいときがあります。この記事では最終行と最終列を取得するVBAのサンプルコードをご紹介します。 A列に5行目までデータが入力されています。 1行目にF列...