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

laoau138

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

乐乐2006201506

这是数组和字典组合法，不能满足你的要求吗？

laoau138

乐乐2006201506 发表于 2017-2-9 19:29
这是数组和字典组合法，不能满足你的要求吗？

只用数组就可以，不想用字典

乐乐2006201506

那先等等高手吧，说实话，我是个VBA菜鸟，现在写代码，也是把自己以前求助别人写的代码，修改了一下而已。
我断断续续也就接触VBA不到半年。

laoau138

乐乐2006201506 发表于 2017-2-9 19:33
那先等等高手吧，说实话，我是个VBA菜鸟，现在写代码，也是把自己以前求助别人写的代码，修改了一下而已。
...

改这个代码，不太难吧

laoau138

乐乐2006201506 发表于 2017-2-9 19:33
那先等等高手吧，说实话，我是个VBA菜鸟，现在写代码，也是把自己以前求助别人写的代码，修改了一下而已。
...

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

today0427

为了和以前的结果进行比对，我将结果放在【k21】起始的单元格，用了两个循环

1. Sub today()
   
2.     Dim arr, brr(), i%
   
3.     arr = Range("c11:h20")
   
4.     ReDim brr(1 To UBound(arr), 1 To 33)
   
5.     For i = 1 To UBound(arr)
   
6.         For j = 1 To UBound(arr, 2)
   
7.             brr(i, arr(i, j)) = 0
   
8.         Next
   
9.     Next
   
10.     For j = 1 To UBound(brr, 2)
    
11.         If Len(brr(1, j)) = 0 Then brr(1, j) = 1
    
12.         For i = 2 To UBound(brr)
    
13.             If Len(brr(i, j)) = 0 Then brr(i, j) = brr(i - 1, j) + 1
    
14.         Next
    
15.     Next
    
16.     [k21].Resize(50, 50).ClearContents
    
17.     [k21].Resize(i - 1, j - 1) = brr
    
18. End Sub

复制代码

laoau138

today0427 发表于 2017-2-9 22:02
为了和以前的结果进行比对，我将结果放在【k21】起始的单元格，用了两个循环

最喜欢看你写，其它写代码我看不懂

today0427

说明咱俩水平差不多

laoau138

today0427 发表于 2017-2-9 22:02
为了和以前的结果进行比对，我将结果放在【k21】起始的单元格，用了两个循环

•   For i = 1 To UBound(arr)
•         For j = 1 To UBound(arr, 2)
•             brr(i, arr(i, j)) = 0
•         Next
•     Next
  

这个代码是不是可以拆开来写