Excel中VBA统计各人员出现的次数并填写到对应位置

yjwdjfqb

Excel中VBA统计各人员出现的次数并填写到对应位置VBA统计表一（D3：D67），中各人员出现的次数，将出现次数填写在表二中
谢谢老师们了！

Excel中VBA统计各人员出现的次数并填写到对应位置.rar (7.6 KB, 下载次数: 10)

2024-3-14 20:56 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, vNum
   
    ar = Sheets(1).[D5].CurrentRegion.Value
    br = [D5].CurrentRegion.Value
    For i = 2 To UBound(br)
        vNum = Empty
        For j = 2 To UBound(ar)
            If br(i, 1) = ar(j, 1) Then vNum = vNum + 1
        Next j
        br(i, 2) = vNum
    Next i
    [D5].CurrentRegion.Value = br
    Beep
End Sub

ykcbf1100

参与一下。。。

ykcbf1100

字典+数组经典用法

1. Sub ykcbf()   '//2024.3.14
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("表一")
   
6.         r = .Cells(.Rows.Count, 4).End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 4)
   
8.     End With
   
9.     For i = 5 To UBound(arr)
   
10.         s = arr(i, 4)
    
11.         d(s) = d(s) + 1
    
12.     Next
    
13.     With Sheets("表二")
    
14.         r = .Cells(.Rows.Count, 4).End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 5)
    
16.         For i = 6 To UBound(arr)
    
17.             s = arr(i, 4)
    
18.             If d.Exists(s) Then
    
19.                 arr(i, 5) = d(s)
    
20.             End If
    
21.         Next
    
22.         .[a1].Resize(r, 5) = arr
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

yjwdjfqb

谢谢二位老师的帮助，非常好用，今天没有花花了，后面补上，谢谢！！！