vba进行提取，并对Col B和Col C进行计数

Question

我在A列中有重复的数据，我想从A列的数据中提取到B列的唯一值，并在C列中获得A列数据重复的计数

在这里，我发现了这个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到9，1到1(，因此您不能在For循环中使用lastR作为限制(仅当数据在Row1中开始时才有效(-请改用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