VBA把字典改写成 纯数组方法 按列计算遗漏值

laoau128

VBA把字典改写成  纯数组方法   按列计算遗漏值



Sub 测试()
Dim ar, arr, brr()
Set d = CreateObject("scripting.dictionary")
ar = Application.Transpose(Application.Transpose(Range("k10:aq10")))
arr = Range("c11:h20")
ReDim brr(1 To UBound(arr), 1 To UBound(ar))
For i = 1 To UBound(arr)
     For j = 1 To UBound(arr, 2)
         d(arr(i, j)) = 0
     Next j
     For ii = 1 To UBound(ar)
         If i = 1 Then
            If Not d.exists(ar(ii)) Then d(ar(ii)) = 1
            brr(i, ii) = d(ar(ii))
         Else
            If d(ar(ii)) <> 0 Or d(ar(ii)) = "" Then
               brr(i, ii) = d(ar(ii)) + 1
               d(ar(ii)) = brr(i, ii)
            Else
               brr(i, ii) = 0
            End If
         End If
     Next ii
     For Each k In d.keys
         If d(k) = 0 Then
            d.Remove k '移除为0的数据
         End If
    Next k
Next i
[k11].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

xiangbaoan

'此贴原先见到过
Sub test()
Dim Arr, Brr%(), r&, c%, x%
[k11].CurrentRegion.Offset(1).ClearContents
Arr = Range("c11:h" & Cells(Rows.Count, 3).End(xlUp).Row)
ReDim Brr%(1 To UBound(Arr), 1 To 33)
For c = 1 To 33
    Brr(1, c) = 1
Next
For c = 1 To 6
    x = Arr(1, c)  '依次读取c11:h11的6个号数
    Brr(1, x) = 0  '把出现过号的位置的1改成0
Next
For r = 2 To UBound(Arr)
    x = 1   '初始值,从第一个号始
    For c = 1 To 33
        If Arr(r, x) = c Then
            Brr(r, c) = 0
            If x < 6 Then x = x + 1
        Else
            Brr(r, c) = Brr(r - 1, c) + 1
        End If
    Next
Next
[k11].Resize(UBound(Brr), 33) = Brr
End Sub

laoau128

xiangbaoan 发表于 2017-2-9 20:27
'此贴原先见到过
Sub test()
Dim Arr, Brr%(), r&, c%, x%

对啊，有问过

laoau128

xiangbaoan 发表于 2017-2-9 20:27
'此贴原先见到过
Sub test()
Dim Arr, Brr%(), r&, c%, x%

http://club.excelhome.net/thread-1327430-1-1.html

VBA代码改写不要用find 明细表

laoau128

xiangbaoan 发表于 2017-2-9 20:27
'此贴原先见到过
Sub test()
Dim Arr, Brr%(), r&, c%, x%

VBA计算等距离间隔循环相同数字

http://club.excelhome.net/thread-1327626-1-1.html

清风竹-

请看附件。

laoau128

清风竹- 发表于 2017-2-11 08:42
请看附件。

大侠这条如何做

VBA计算等距离间隔循环相同数字

http://club.excelhome.net/thread-1327626-1-1.html