数据结构如何实现呢?

class11class

A,B两列数据,标注颜色只为了区分结构,不要求颜色,如何实现上述的数据结构呢?

wang-way

我来想一个妙招 哈哈

shiruiqiang

shiruiqiang

wang-way

不知道是不是你想要的

1. Sub main()
   
2.     Dim wb As Workbook
   
3.     Dim sht As Worksheet
   
4.     Set dic = CreateObject("Scripting.Dictionary")
   
5.     Set wb = Application.ThisWorkbook
   
6.     Set sht = wb.Worksheets(1)
   
7.     With sht
   
8.         erow = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.         r = 0
   
10.         For i = 1 To erow
    
11.             ar = Split(.Cells(i, 1).Value, "/")
    
12.             For Each e In ar
    
13.                 If e <> "" Then
    
14.                     a = RegReplace(e, "\d", "#")
    
15.                     If dic.exists(a) = False Then
    
16.                         dic(a) = Int(65536 * Rnd)
    
17.                         Debug.Print dic(a)
    
18.                     End If
    
19.                     r = r + 1
    
20.                     .Cells(r, 3).Value = e
    
21.                     .Cells(r, 3).Interior.Color = dic(a)
    
22.                 End If
    
23.             Next
    
24.         Next i
    
25.     End With
    
26. End Sub
    
27. Function RegReplace(ByVal text As String, ByVal pat As String, Optional rep As String = "") As String
    
28.     Dim reg, ms, m
    
29.     Set reg = CreateObject("VBScript.RegExp")
    
30.     With reg
    
31.         .Global = True
    
32.         .IgnoreCase = True
    
33.         .Pattern = pat
    
34.     End With
    
35.     RegReplace = reg.Replace(text, rep)
    
36.     Set reg = Nothing
    
37. End Function

复制代码

今铭昔

quqiyuan

就是数组问题嘛。。。供参考。。。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, r&, aMatch As Object
   
    ar = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ReDim br(1 To UBound(ar) * 10, 0)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[\d\.\-]+"
        For i = 1 To UBound(ar)
            For Each aMatch In .Execute(ar(i, 1))
                r = r + 1
                br(r, 0) = aMatch.Value
            Next
        Next i
    End With
   
    Columns("D").Clear
    If r Then [d1].Resize(r) = br
    Beep
End Sub

gwjkkkkk

...........

准提部林

sub TTest()
arr = Range([A1],[a65536].End(3))
ReDim brr(1 To UBound(arr) * 10, 0)
for i=1 to ubound(arr)
     for each x in split(arr(i,1),"/")
          if trim(x)<>"" then n=n+1:brr(n,0)=trim(x)
    next
next i
[d1].resize(n)=brr
end sub