如何让一个字符串按照另一个字符串的顺序排列

Option Explicit

Private Type 数据结构
    N() As String
    j() As Long
End Type


Private Sub Command1_Click()

Dim c As 数据结构           '结果
Dim a() As String           '参照
Dim b() As String           '目标

Dim s As String             '临时
Dim i As Long, j As Long, o As Long, d As Long
'i,j 循环，o 位置计数 ,d 从哪个位置开始是不存在于参照中的

s = Text1.Text          '取数
Call 清多余空格(s)      '去多余空格
a = Split(s, " ")       '分解

s = Text2.Text
Call 清多余空格(s)
b = Split(s, " ")

ReDim c.N(UBound(b) + 1)        '结果从1写起，防止没有任何相同项时报错
ReDim c.j(UBound(b) + 1)

o = 0                   '结果数组从1写起，无法从0写起，判断时会出错
For i = 0 To UBound(a)
    For j = 0 To UBound(b)
        If InStr(1, b(j), a(i)) = 1 Then        '目标数组的前面参数数组元素相同
            s = Mid(b(j), Len(a(i)) + 1)        '去掉相同部分
            If IsNumeric(s) Then                '剩余部分是否为数值
                If c.N(o) <> a(i) Then          '如果不同，说明该值没有统计
                    o = o + 1                   '使用下一个空白的
                End If
               
                c.N(o) = a(i)                   '名字
                c.j(o) = c.j(o) + Val(s)        '求和
               
                b(j) = ""                       '已使用了
            End If
        End If
    Next j
Next i

o = o + 1           'o已使用，所以要+1
d = o
For j = 0 To UBound(b)
    If b(j) <> "" Then
        c.N(o) = b(j)       '未使用的，不求和了，直接输出
        b(j) = ""
        o = o + 1
    End If
Next j

s = ""
For i = 1 To d - 1
    s = s & c.N(i) & c.j(i) & " "
Next i

If Len(s) > 0 Then
    Label1.AutoSize = True
    Label1.Caption = s
Else
    Label1.Caption = ""
    Label1.Width = 1                'label1的位置和宽度决定label2的位置，不知这里给0会不会出错，没去测试
End If

s = ""
For i = d To UBound(b) + 1
    If c.N(i) <> "" Then
        s = s & c.N(i) & " "
    End If
Next i

If Len(s) > 0 Then                  '如果不存在数据，则不显示
    Label2.Visible = True
    Label2.AutoSize = True
    Label2.Caption = s
    Label2.ForeColor = vbRed
    Label2.Left = Label1.Left + Label1.Width
Else
    Label2.Visible = False
End If
End Sub



Public Sub 清多余空格(ByRef s As String)        '显式申明按地址传递
Dim i As Long, j As Long

s = Trim(s)
j = Len(s)
Do
    i = j
    s = Replace(s, "  ", " ")
    j = Len(s)
Loop While i <> j
End Sub