【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

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