[已解决]请老师帮我解释这个代码

lzclzch

Private Sub CommandButton3_Click()
Sheet2.Range("b3:d2000").ClearContents
  Dim i%, z%, c As Range, x, d As Object, arr(), brr
    x = Sheet4.[b65536].End(xlUp).Row
     brr = Sheet4.Range("a7:c" & x)
     ReDim arr(1 To x, 1 To 1)
For z = 1 To UBound(brr)
On Error Resume Next
If brr(z, 1) >= Sheet2.Range("b1") And brr(z, 1) <= Sheet2.Range("c1") And brr(z, 2) = Sheet2.Range("c2") Then
n = n + 1
arr(n, 1) = brr(z, 3)
End If
    Next
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
            d(arr(i, 1)) = d(arr(i, 1)) + 1
            s = s + 1
        End If
    Next
    k = d.keys: t = d.items
    ReDim arr(1 To 3, 1 To d.Count)
    For i = 1 To d.Count
        arr(2, i) = Application.Max(t)
        arr(3, i) = arr(2, i) / s
        w = Application.Match(arr(2, i), t, 0) - 1
        arr(1, i) = k(w)
        t(w) = ""
    Next i
    Sheet2.Range("b3").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
End Sub
能不能再简化一下
在此谢谢

最佳答案

月排行榜 / 总排行榜

zjdh

2011-8-20 21:38

1. '*****筛选不重复并统计重复数******   
   
2.     Set d = CreateObject("Scripting.Dictionary") '建立字典
   
3.     For i = 1 To UBound(arr)        '逐个筛选   
   
4.         If arr(i, 1) <> "" Then     '若第一位有数据   
   
5.             d(arr(i, 1)) = d(arr(i, 1)) + 1   '建立Key并计数+1
   
6.             s = s + 1     '总数+1
   
7.         End If
   
8.     Next
   
9.    '*****以下是数组排序********
   
10.     k = d.keys: t = d.items         '字典数据分别赋值给2个数组变量
    
11.     ReDim arr(1 To 3, 1 To d.Count)   '重新定义数组
    
12.     For i = 1 To d.Count              '逐个筛选
    
13.         arr(2, i) = Application.Max(t)  '获得数组变量中最大值 （重复数）
    
14.         arr(3, i) = arr(2, i) / s       '获得全局比例值
    
15.         w = Application.Match(arr(2, i), t, 0) - 1   '最大值在数组中的序号
    
16.         arr(1, i) = k(w)        '获得对应Key （姓名）
    
17.         t(w) = ""               '删除已删选过的最大值
    
18.     Next i
    
19.    '**********'数组赋值给工作表*******
    
20.     Sheet2.Range("b3").Resize(UBound(arr, 2), UBound(arr)) =     Application.Transpose(arr)   

复制代码

前半段好理解，你自己写的就不解释了，后半段解释如上：

跳转到最佳答案楼层

zjdh

看着后半段怎么象我写的？

zjdh

1. '*****筛选不重复并统计重复数******   
   
2.     Set d = CreateObject("Scripting.Dictionary") '建立字典
   
3.     For i = 1 To UBound(arr)        '逐个筛选   
   
4.         If arr(i, 1) <> "" Then     '若第一位有数据   
   
5.             d(arr(i, 1)) = d(arr(i, 1)) + 1   '建立Key并计数+1
   
6.             s = s + 1     '总数+1
   
7.         End If
   
8.     Next
   
9.    '*****以下是数组排序********
   
10.     k = d.keys: t = d.items         '字典数据分别赋值给2个数组变量
    
11.     ReDim arr(1 To 3, 1 To d.Count)   '重新定义数组
    
12.     For i = 1 To d.Count              '逐个筛选
    
13.         arr(2, i) = Application.Max(t)  '获得数组变量中最大值 （重复数）
    
14.         arr(3, i) = arr(2, i) / s       '获得全局比例值
    
15.         w = Application.Match(arr(2, i), t, 0) - 1   '最大值在数组中的序号
    
16.         arr(1, i) = k(w)        '获得对应Key （姓名）
    
17.         t(w) = ""               '删除已删选过的最大值
    
18.     Next i
    
19.    '**********'数组赋值给工作表*******
    
20.     Sheet2.Range("b3").Resize(UBound(arr, 2), UBound(arr)) =     Application.Transpose(arr)   

复制代码

前半段好理解，你自己写的就不解释了，后半段解释如上：

lzclzch

是你写的
我想改又不态明白所以想解释一下