VBA字典改写用数组方法计算

Zamyi

1. Private Declare Function hash Lib "ntdll.dll" Alias "RtlComputeCrc32" (ByVal start As Long, ByVal data As Long, ByVal Size As Long) As Long
   
2. Sub test()
   
3. Dim H_T() As Long, Count_T As Long, H As Long, Count As Long, i&, k&
   
4. r = Range("b2:c" & Range("c65536").End(3).Row)
   
5. Count_T = UBound(r) * 1.5
   
6. ReDim H_T(Count_T - 1)
   
7. For i = 1 To UBound(r)
   
8.   k = 0
   
9.   H = (hash(0, StrPtr(r(i, 1)), LenB(r(i, 1))) And &H7FFFFFFF) Mod Count_T
   
10.   Do
    
11.     If H_T(H) = 0 Then
    
12.       Count = Count + 1
    
13.       H_T(H) = Count
    
14.       r(H_T(H), 1) = r(i, 1)
    
15.       r(H_T(H), 2) = r(i, 2)
    
16.       Exit Do
    
17.     End If
    
18.     If StrComp(r(i, 1), r(H_T(H), 1)) = 0 Then
    
19.       r(H_T(H), 2) = r(H_T(H), 2) + r(i, 2)
    
20.       Exit Do
    
21.     End If
    
22.     k = k + 1
    
23.     H = (H + k * k) Mod Count_T
    
24.   Loop
    
25. Next
    
26. Range("e11").Resize(Count, 2) = r
    
27. End Sub
    

复制代码

laoau128

Zamyi 发表于 2018-12-6 15:43

完全看不懂了第一句是什么

laoau128

Zamyi 发表于 2018-12-6 15:43

我觉得简单就好，没有必要写太复杂

laoau128

Zamyi 发表于 2018-12-6 15:43

果然是高手

laoau128

一把小刀闯天下 发表于 2018-12-6 14:42
Option Explicit

Sub test()

VBA用两种方法  找出两列相同两列不同

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

laoau128

gufengaoyue 发表于 2018-12-6 15:10
能少用循环就少用。数据多了就慢了。

VBA用两种方法  找出两列相同两列不同

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

mxscgwh

分享有掌声

zhangcheng6688

一把小刀闯天下 发表于 2018-12-6 14:59
'数据量小不用排序也可以，，，

Option Explicit

谢谢您的代码，感觉用两个数组的话更好理解一些，
Dim arr, i, j, m, brr
  ReDim brr(1 To 12, 1 To 2)
  arr = [b2:c12]
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 1)) Then
      m = m + 1: brr(m, 1) = arr(i, 1)
      brr(m, 2) = arr(i, 2)
      For j = i + 1 To UBound(arr, 1)
        If Len(arr(j, 1)) Then
          If arr(j, 1) = brr(m, 1) Then
            brr(m, 2) = brr(m, 2) + arr(j, 2): arr(j, 1) = vbNullString
          End If
        End If
      Next
    End If
  Next
  [e18].Resize(m, UBound(brr, 2)) = brr

laoau128

zhangcheng6688 发表于 2018-12-8 08:19
谢谢您的代码，感觉用两个数组的话更好理解一些，
Dim arr, i, j, m, brr
  ReDim brr(1 To 12, 1 To  ...

写得好，非常有道理了

OKJSJSF

看看快排是什么。