求助：VBA 快速统计重复值的个数，请老师帮忙指导下，谢谢

yihaoshulan

求助：问题待解决 .zip (23.04 KB, 下载次数: 7)

2022-9-30 09:12 上传

点击文件名下载附件
统计重复值个数

问题描述 ：统计蓝色区域每行与绿色区域所有列重复值的个数

非常重要  非常重要  非常重要

如果 绿色区域每列 有重复的数字， 那么蓝色区域 每行与绿色区域 列  比对 统计重复值个数的时候，

只算作一次，绿色区域 每列里面的重复值 只算作一次

由于今天无法上传附件，给出的例子 容易造成误解 已删除，谢谢 大家打开文件的时候 不用看“ 正确示例”

文件请参考附件，谢谢

yihaoshulan

自己顶下，提前预祝各位兄弟姐妹国庆假期快乐

micch

=count(match($a1:$g1,r:r,))  H1输入，右拉下拉

哒哒哒是的撒多

问题待解决 求助.zip (33.59 KB, 下载次数: 8)

2022-9-30 12:40 上传

点击文件名下载附件

DevilW

DevilW

1. Sub test()
   
2.     Set reg = CreateObject("vbScript.Regexp")
   
3.     reg.Global = True
   
4.     reg.Pattern = ".*?(\b\d+\b)(?=.*?@.*?\b\1\b)|.+"
   
5.     ar = [a1:g144] '读取蓝区
   
6.     br = [r1:w57] '读取绿区
   
7.     ReDim s1(1 To UBound(ar)) '存放蓝区合并文本
   
8.     ReDim s2(1 To UBound(br, 2)) '存放绿区合并文本
   
9.     ReDim cr(1 To UBound(ar), 1 To UBound(br, 2)) '存放结果
   
10.     For i = 1 To UBound(ar) '收集蓝区数据文本
    
11.         t = ""
    
12.         For j = 1 To UBound(ar, 2)
    
13.             t = t & " " & ar(i, j)
    
14.         Next
    
15.         s1(i) = t
    
16.     Next
    
17.     For i = 1 To UBound(br, 2) '收集绿区数据文本
    
18.         t = ""
    
19.         For j = 1 To UBound(br)
    
20.             t = t & " " & br(j, i)
    
21.         Next
    
22.         s2(i) = t
    
23.     Next
    
24.     For i = 1 To UBound(s1) '对比数据
    
25.         n = 0
    
26.         For j = 1 To UBound(s2)
    
27.             t = reg.Replace(s2(j) & "@" & s1(i), " $1")
    
28.             cr(i, j) = UBound(Split(Trim(t))) + 1
    
29.         Next
    
30.     Next
    
31.     [h1].Resize(UBound(s1), UBound(s2)) = cr
    
32. End Sub

复制代码

yihaoshulan

DevilW 发表于 2022-9-30 13:15

谢谢 老师 指正，这个 举例 是我当时把重复的做了2次， 我没有做及时更改，对不起，再次感谢指正！

yihaoshulan

micch 发表于 2022-9-30 11:08
=count(match($a1:$g1,r:r,))  H1输入，右拉下拉

好的 谢谢 大佬指导

yihaoshulan

yihaoshulan 发表于 2022-9-30 15:26
谢谢 老师 指正，这个 举例 是我当时把重复的做了2次， 我没有做及时更改，对不起，再次感谢指正！

Sub test()
   Set reg = CreateObject("vbScript.Regexp")
   reg.Global = True
   reg.Pattern = " .*?(\b\d+\b)(?=.*?@.*?\b\1\b)|.+"
   ar = [a1：g144]
   br = [r1：w57]
   ReDim s1(1 To UBound(ar))
   ReDim s2(1 To UBound(br, 2))
   ReDim cr(1 To UBound(ar), 1 To UBound(br, 2))
   For i = 1 To UBound(ar)
       t = ""
       For j = 1 To UBound(ar, 2)
           t = t & " " & ar(i, j)
       Next
       s1(i) = t
      
    Next
    For i = 1 To UBound(br, 2)
        t = ""
        For j = 1 To UBound(br)
            t = t & " " & br(j, i)
       Next
       s2(i) = t
      
    Next
    For i = 1 To UBound(s1)
        n = 0
        For j = 1 To UBound(s2)
            t = reg.Replace(s1(i) & "@" & s2(j), "$1")
            cr(i, j) = UBound(Split(Trim(t))) + 1
            
        Next
        
    Next
    [h1].Resize(UBound(s1), UBound(s2)) = cr
End Sub



OK  解决了

清风竹-

请看附件。