拆分

excelkong

原格式为1/2/3 9 4/5/6/7/8 10
希望把数字取出来，放在一列。
请帮忙看VBA怎么写。

小花鹿

两次SPLIT分割

鄂龙蒙

1. Sub 拆分不重复()
   
2.     [F2:F1000] = Empty
   
3.     Dim d, i, m, arr, brr(), x, a
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheet1.UsedRange
   
6.     For i = 2 To UBound(arr)
   
7.         If Len(arr(i, 1)) Then
   
8.             If InStr(arr(i, 1), "/") Then
   
9.                 a = Split(arr(i, 1), "/")
   
10.                 For x = 0 To UBound(a)
    
11.                     d(a(x)) = ""
    
12.                 Next
    
13.              Else
    
14.                 d(arr(i, 1)) = ""
    
15.             End If
    
16.         End If
    
17.     Next
    
18.     [F2].Resize(d.Count) = Application.Transpose(d.keys)
    
19.     Set d = Nothing
    
20. End Sub

复制代码

excelkong

鄂龙蒙 发表于 2020-1-11 18:59

感谢您！

excelkong

小花鹿 发表于 2020-1-11 17:53
两次SPLIT分割

不好意思，我是门外汉，知其然不知其所以然。

excelkong

小花鹿 发表于 2020-1-11 17:53
两次SPLIT分割

感谢您的指导。

eashon111

Sub test()
Dim arr, i&, arr1, arr2(), k&
arr = Range(Range("A2"), Range("a65536").End(xlUp))
  ReDim arr2(1 To UBound(arr), 1 To 1)
   k = 1
    For i = 1 To UBound(arr)
     If arr(i, 1) <> "" Then
     arr2(k, 1) = arr(i, 1)
    k = k + 1
   End If
  Next
arr1 = Split(Join(Application.Transpose(arr2), "/"), "/")
[b2].Resize(UBound(arr1), 1) = Application.Transpose(arr1)
End Sub

micch

Sub test()
Set d = CreateObject("Scripting.Dictionary")
x = "1/2/3 9 4/5/6/7/8 10"
ar = Split(Replace(x, "/", " "))
For Each a In ar: d(a) = 1: Next
[c1].Resize(d.Count) = Application.Transpose(d.keys)
End Sub