VBA对列中的值进行计数并将表填充到另一个工作表中

Sub CountAndFill()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim uniqueValues As Collection
    Dim cellValue As Variant
    Dim i As Integer
    
    ' 设置源工作表和目标工作表
    Set sourceSheet = ThisWorkbook.Sheets("源工作表名称")
    Set targetSheet = ThisWorkbook.Sheets("目标工作表名称")
    
    ' 设置源范围（假设数据在第一列，从第2行开始）
    Set sourceRange = sourceSheet.Range("A2:A" & sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row)
    
    ' 创建一个集合对象来存储唯一值
    Set uniqueValues = New Collection
    
    ' 遍历源范围，将唯一值添加到集合中
    On Error Resume Next
    For Each cellValue In sourceRange
        uniqueValues.Add cellValue, CStr(cellValue)
    Next cellValue
    On Error GoTo 0
    
    ' 在目标工作表中填充唯一值和计数
    Set targetRange = targetSheet.Range("A2:B" & uniqueValues.Count + 1)
    i = 1
    For Each cellValue In uniqueValues
        targetRange.Cells(i, 1).Value = cellValue
        targetRange.Cells(i, 2).Value = Application.WorksheetFunction.CountIf(sourceRange, cellValue)
        i = i + 1
    Next cellValue
End Sub