比较难的提取数据

grf1973

模拟了一组（G--BN）列，结果显示在x列。
好象和原结果不一致。

1. Sub 提取()
   
2.     arr = Sheets(1).[g1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     Dim brr(0 To 999)   'brr(x):数字x出现的列数
   
6.     For j = 1 To 60
   
7.         For i = 1 To UBound(arr)
   
8.             x = arr(i, j)
   
9.             If Len(x) > 0 Then
   
10.                 If Not d.exists(x) Then
    
11.                     d(x) = 1
    
12.                     brr(Val(x)) = brr(Val(x)) + 1
    
13.                 End If
    
14.             End If
    
15.         Next
    
16.         d.RemoveAll
    
17.     Next
    
18. 
    
19.     For i = 0 To 999   'd1(x):x列出现的所有数字
    
20.         If Len(brr(i)) Then d1(brr(i)) = d1(brr(i)) & "," & Format(i, "000")
    
21.     Next
    
22. 
    
23.     crr = Sheets(1).Range("d1:d" & [d65536].End(3).Row)
    
24.     For i = 1 To UBound(crr)
    
25.         If Len(crr(i, 1)) Then s = s & d1(crr(i, 1))
    
26.     Next
    
27.    
    
28.     xrr = Split(Mid(s, 2), ",")
    
29.     With Sheets(2)
    
30.         [x:x].ClearContents
    
31.         .[x1].Resize(UBound(xrr) + 1) = Application.Transpose(xrr)
    
32.         .Activate
    
33.     End With
    
34. End Sub
    

复制代码

meet10010

grf1973 发表于 2018-7-26 10:25
模拟了一组（G--BN）列，结果显示在x列。
好象和原结果不一致。

出现下标越界，代码无法执行。