VBA实现提取未出现数据

灯火阑珊888

请教老师，如何用 VBA实现提取数据.rar (4.2 KB, 下载次数: 17)

2018-9-9 00:48 上传

点击文件名下载附件

VBA实现提取未出现数据

xiangbaoan

Sub test()'仅供参考
Dim ar, s$, t$, r&, c%, i%, tp, n$
s = "0123456789"
ar = [a1].CurrentRegion.Resize(, 3)
For r = 1 To UBound(ar)
    tp = Split(Replace(ar(r, 1), " ", ""), ",")
    For c = 0 To UBound(tp)
        n = tp(c)
        t = s
        For i = 1 To Len(n)
            t = Replace(t, Mid(n, i, 1), "")
        Next
        tp(c) = t
    Next
    ar(r, 3) = Join(tp, ",")
Next
[a1].CurrentRegion.Resize(, 3) = ar
End Sub

约定的童话

能问下这么奇葩的要求用在什么地方吗？加密用？

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a1:a" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To 1)
   
8.     For i = 1 To UBound(arr)
   
9.       s1 = ""
   
10.       crr = Split(Replace(arr(i, 1), " ", ""), ",")
    
11.       For j = 0 To UBound(crr)
    
12.         ReDim drr(0 To 9)
    
13.         For k = 1 To Len(crr(j))
    
14.           n = Val(Mid(crr(j), k, 1))
    
15.           drr(n) = 1
    
16.         Next
    
17.         s2 = ""
    
18.         For w = 0 To 9
    
19.           If Len(drr(w)) = 0 Then
    
20.             s2 = s2 & w
    
21.           End If
    
22.         Next
    
23.         s1 = s1 & "," & s2
    
24.       Next
    
25.       brr(i, 1) = Mid(s1, 2)
    
26.     Next
    
27.     .Columns(4).NumberFormatLocal = "@"
    
28.     .Range("d1").Resize(UBound(brr), 1) = brr
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

以前好像回答过楼主类似的问题。

灯火阑珊888

chxw68 发表于 2018-9-9 11:28
以前好像回答过楼主类似的问题。

谢谢chxw68老师 完美解决了