统计不重复值及次数，谢谢几位老师！

caiyu93 · 发表于 2023-10-23 14:10

lhj323323 发表于 2023-10-23 14:03
谢谢老师
XLSM格式，打不开。

重新上传了,xls格式的Resize最大只能重设65535,而xlsm格式没有限制

lhj323323 · 发表于 2023-10-23 14:14

caiyu93 发表于 2023-10-23 14:10
重新上传了,xls格式的Resize最大只能重设65535,而xlsm格式没有限制

谢谢老师的耐心，我是因自身原因，没法安装新版的EXCEL，只能使用XLS这一种格式，给您添麻烦了。
鲜花明日奉上。

lhj323323 · 发表于 2023-10-23 14:16

caiyu93 发表于 2023-10-23 14:10
重新上传了,xls格式的Resize最大只能重设65535,而xlsm格式没有限制

老师

运行后，没有生成次数
请看下图
快照3.png

caiyu93 · 发表于 2023-10-23 15:04

lhj323323 发表于 2023-10-23 14:16
老师

右边结果就是只有一次的生成了次数也没有意义啊?都是不重复的呢

lhj323323 · 发表于 2023-10-23 15:08

caiyu93 发表于 2023-10-23 15:04
右边结果就是只有一次的生成了次数也没有意义啊?都是不重复的呢

有意义啊，。

caiyu93 · 发表于 2023-10-23 15:12

lhj323323 发表于 2023-10-23 15:08
有意义啊，。

更新了

zhangcheng6688 · 发表于 2023-10-29 07:23

学习一下
arr = Range("b2:b" & Cells(Rows.Count, "b").End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
      m = m + 1
      brr(m, 1) = arr(i, 1)
      brr(m, 2) = 1
      For j = i + 1 To UBound(arr)
         If arr(j, 1) <> "" Then
            If arr(i, 1) = arr(j, 1) Then
                  brr(m, 2) = brr(m, 2) + 1
                  arr(j, 1) = vbnullsting
            End If
         End If
      Next
End If
Next
[e2].Resize(UBound(brr), 2) = brr

zhangcheng6688 · 发表于 2024-3-11 08:02

向老师学习一下字典，感谢
Sub test()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 2)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If Not d.exists(arr(i, 2)) Then
   m = m + 1
   d(arr(i, 2)) = m
   brr(m, 1) = arr(i, 2)
   brr(m, 2) = 1
Else
   p = d(arr(i, 2))
   brr(p, 2) = brr(p, 2) + 1
End If
Next
[e2].Resize(m, UBound(brr, 2)) = brr
End Sub

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

[已解决] 统计不重复值及次数，谢谢几位老师！

评分