excel - vba 提取和唯一的 Col B 并计数到 Col C

Question

我在 A 列中有重复的数据我想从 A 列数据中提取唯一值到 B 列并获取 A 列数据重复项的 C 列中的计数
在这里我发现这个 vba 代码在数据从 A1 列开始且没有标题时工作
这是我的问题，我有如下示例的标题数据

Col A1 Fruits    Column B1 Fruits  Column C1 Dup Count
Apple                         
Banana                     
Apple                      
Orange
Banana
Orange
Apple

我需要像下面这样的输出示例

Col A1 Fruits    Column B1 Fruits  Column C1 Dup Count
Apple            Apple            3  
Banana           Banana           2
Apple            Orange           2
Orange
Banana
Orange
Apple

在这里，当我根据我得到的数据运行这个 vba 代码时(运行时错误“9”)(下标超出范围)
这行代码以黄色突出显示

dict(arr(i, 1)) = dict(arr(i, 1)) + 1

Sub uniqueValues()
   Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
   
   Set sh = ActiveSheet 'use here the sheet you need
   lastR = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
   arr = Range("A2:A" & lastR).Value
   Set dict = CreateObject("Scripting.Dictionary")
   For i = 1 To lastR
        dict(arr(i, 1)) = dict(arr(i, 1)) + 1
   Next i
   arrFin = Application.Transpose(Array(dict.Keys, dict.items))
   sh.Range("B2").Resize(dict.Count, 2).Value = arrFin
End Sub

Answer 1

如果最后一行是(例如)10，那么你的数组 arr大小为 (1 to 9, 1 to 1) 所以你不能使用 lastR作为您的 For 中的限制循环(仅当数据从第 1 行开始时才有效)- 使用 For i = 1 To UBound(arr, 1)反而。

Sub uniqueValues()
   Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
   
   Set sh = ActiveSheet 'use here the sheet you need
   lastR = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
   arr = Range("A2:A" & lastR).Value
   Set dict = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(arr, 1) '<<<< not `lastR`
        dict(arr(i, 1)) = dict(arr(i, 1)) + 1
   Next i
   arrFin = Application.Transpose(Array(dict.Keys, dict.items))
   sh.Range("B2").Resize(dict.Count, 2).Value = arrFin
End Sub