【VBA】項目ごとのカウントを行う
VBAでシート上の項目ごとのデータ数のカウントを行うには、Dictionaryオブジェクトを使用すると
簡単に項目のカウントを行うことができます。
シートのA列に4種類の食べ物を入力しました。入力した食べ物を種類ごとにカウントしてみます。

Dictionaryオブジェクトを使用するのでMicrosoft Scripting Runtimeに参照設定を行う必要があります。
https://kazusa-pg.com/vba-references/
シート上の項目のカウントを行うコードは以下になります。
1Option Explicit
2
3Public Sub CountItem(sht As Worksheet, col As Long)
4'###################################################################################
5'シート上の項目のカウントを行い、メッセージボックスに表示する
6'Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要
7'-----------------------------------------------------------------------------------
8'引数 :sht 項目のカウントを行いたいシート
9' :col 項目のカウントを行いたい列番号
10'###################################################################################
11
12 Dim lastRow As Long
13 lastRow = GetMaxRow(sht, col)
14
15 Dim dic As Dictionary
16 Set dic = New Dictionary
17 Dim i As Long
18 Dim v As String
19 For i = 1 To lastRow
20 v = sht.Cells(i, 1)
21 If dic.Exists(v) Then
22 dic(v) = dic(v) + 1
23 Else
24 dic.Add v, 1
25 End If
26 Next i
27
28 For i = 0 To dic.Count - 1
29 MsgBox dic.Keys(i) & "は" & dic.Items(i) & "個"
30 Next i
31
32 Set dic = Nothing
33
34End Sub
35
36Private Function GetMaxRow(sht As Worksheet, check_col As Long) As Long
37
38 Dim lastRow As Long
39 lastRow = sht.UsedRange.Row + sht.UsedRange.Rows.Count - 1
40 GetMaxRow = 0
41
42 Dim readRow As Long
43 For readRow = lastRow To 1 Step -1
44 If sht.Cells(readRow, check_col).Value <> "" Then
45 GetMaxRow = readRow
46 Exit For
47 End If
48 Next
49
50End Function
51
52Public Sub TestCountItem()
53
54 Dim sht As Worksheet
55 Set sht = ThisWorkbook.Worksheets("Sheet1")
56
57 Call CountItem(sht, 1)
58
59 Set sht = Nothing
60
61End Sub
TestCountItemを実行すると、シートのA列の項目のカウントを行います。
入力されている食べ物のそれぞれの個数がメッセージボックスに表示されます。
1りんごは4個
2レタスは3個
3牛肉は2個
4水は1個
データの最終行を取得するためにコード内でGetMaxRowを使用しています。
GetMaxRowについては以下の記事をご覧ください。
https://kazusa-pg.com/vba-get-max-row-column-number/