求大师给一个包含计数包含数字格式的VBA

飞越一切 · 发表于 2024-7-1 14:02

dalyfreak 发表于 2024-6-28 19:00

大哥，为啥只出A2,A3单元格的结果呢，其它没反应，需要修改哪里，麻烦看看

dalyfreak · 发表于 2024-7-20 22:59

飞越一切发表于 2024-7-1 14:02
大哥，为啥只出A2,A3单元格的结果呢，其它没反应，需要修改哪里，麻烦看看

代码第7行的for语句中to后面的“3”改成“R2”，为了测试方便，我只循环了1次。

longwin · 发表于 2024-7-21 00:43

参与一下：
Sub test()
arr = Sheets("原数1").[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
Set dhz = CreateObject("scripting.dictionary")
brr = Sheets("统计数2").Range("A2:A" & Sheets("统计数2").[A2].End(xlDown).Row)
For i = 1 To UBound(brr)
d.RemoveAll
   crr = Split(brr(i, 1), ",")
For c = 0 To UBound(crr)
      d(crr(c)) = 0
Next
For m = 2 To UBound(arr)
      drr = Split(arr(m, 1), ",")
      gs = 0
      For t = 0 To UBound(drr)
         If d.exists(drr(t)) Then gs = gs + 1
      Next
   If Not dhz.exists(i) Then Set dhz(i) = CreateObject("scripting.dictionary")
      dhz(i)(gs) = dhz(i)(gs) + 1
Next
Next
ReDim grr(1 To UBound(brr), 1 To UBound(crr) + 1)
For Each Key In dhz.keys
For Each gs In dhz(Key)
      grr(Key, gs) = dhz(Key)(gs)
Next
Next
Sheets("统计数2").[b2].Resize(UBound(grr), UBound(grr, 2)) = grr
Set d = Nothing
Set dhz = Nothing
End Sub

飞越一切 · 发表于 2024-7-25 16:50

dalyfreak 发表于 2024-7-20 22:59
代码第7行的for语句中to后面的“3”改成“R2”，为了测试方便，我只循环了1次。

大哥，非常感谢

飞越一切 · 发表于 2024-7-25 16:53

longwin 发表于 2024-7-21 00:43
参与一下：
Sub test()
arr = Sheets("原数1").[a1].CurrentRegion

变换数据后，显示下标越界

longwin · 发表于 2024-7-25 17:48

测试没有问题，看一下现在的数据跟样本有什么区别，或者发上来看一下也行

飞越一切 · 发表于 2024-8-16 15:41

longwin 发表于 2024-7-25 17:48
测试没有问题，看一下现在的数据跟样本有什么区别，或者发上来看一下也行

大哥，帮忙看看，显示下标越界

统计每组包含对应数量的总数（溢出）.rar (389.18 KB, 下载次数: 2)

		自动登录	找回密码
密码			免费注册

[求助] 求大师给一个包含计数包含数字格式的VBA

评分