数组a()是苹果 香蕉 桔子 西瓜
文本框输入 苹果1 西瓜2 桔子3 苹果2 香蕉4 西瓜5
怎么让文本框内容按照数组a的顺序排列，数字要跟在原来的文字后面，并且把重复项相加
输出结果是苹果3 香蕉4 桔子3 西瓜7

如果文本框中输入的水果名不存在数组a当中，如西瓜2 桔子3 苹果2 番茄1，则直接输出番茄1不存在

我把文字和数字分别提取出来，单独作为数组，提取数字的时候，总提示类型错误

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

我按照我的思路写的

用另一种方法也可以实现，仅供参考：

Private Sub Command1_Click()
Dim A, B() As String, C() As Integer, T As Integer, Y As Integer, SW() As String, D() As Integer, X As Integer
A = Array("苹果", "香蕉", "桔子", "西瓜")
Y = Len(Text1.Text)
ReDim SW(1 To Y)
For I = 1 To Len(Text1.Text)
    If InStr(I, Text1.Text, Space(1), 1) > 1 Then
    T = InStr(I, Text1.Text, Space(1), 1)
    SW(I) = Right(Left(Text1.Text, Y - T), 3)
    End If
Next I   '以上分解Text1.Text到SW(I)数组
SW(I - 1) = Right(Text1.Text, 3)    '将最后一组存储在最后数组中
T = 0
For I = 1 To Y - 1
    For J = I + 1 To Y
    If SW(I) = SW(J) Then
    SW(J) = ""
    T = T + 1
    End If
    Next J
Next I   '以上将相同的数组值清空
ReDim B(1 To T), C(1 To T)
T = 0
For I = 1 To Y
    If SW(I) <> "" Then
    T = T + 1
    B(T) = Trim(SW(I))  '将不是空值的SW(I)值存储在B(T)数组
    C(T) = Val(Right(B(T), 1))   '取得B(T)最后一个字符转换为数字存储在C(T)数组中
    End If
Next I    '以上得到正确的文本框的数组的值与最后一个数字
X = UBound(A)
ReDim D(0 To X)
For I = 0 To X
    For J = 1 To T
        If Mid(B(J), 1, 2) = A(I) Then
        D(I) = D(I) + C(J)
        End If
    Next J
Next I
Text2.Text = ""
For I = 0 To X
Text2.Text = Text2.Text & A(I) & CStr(D(I)) & Space(2)
Next I
End Sub

Private Sub Form_Load()
Text1.Text = "苹果1 西瓜2 桔子3 苹果2 香蕉4 西瓜5"
End Sub

如果数字大于10呢？比如“苹果12”？

下述代码应该对楼主有用：

Function Vegetables(Varieties As String, Stock As String)
  'Varieties字符串品种规则是用空格间隔开,Stock品种可以用任意西文字符间隔开
  Dim i As Integer, j As Integer, k As Integer, a() As String, b() As String, c As String, d As String, e As String
  a = Split(Varieties, " ")
  d = Stock
  For i = 0 To UBound(a)
    If a(i) <> "" Then
      b = Split(Stock, Trim(a(i)))
      k = 0
      d = Trim(Replace(d, Trim(a(i)), ""))
      For j = 0 To UBound(b)
        k = k + Val(b(j))
      Next
      c = c & a(i) & k & " "
    End If
  Next
  For i = 1 To Len(d)
    If (Mid(d, i, 1) = " " And Right(e, 1) <> " ") Or Asc(Mid(d, i, 1)) > 128 Or Asc(Mid(d, i, 1)) < 0 Then e = e & Mid(d, i, 1)
  Next
  If Trim(e) <> "" Then c = c & "没有的品种:" & Trim(e)
  Vegetables = c
End Function
Private Sub Command1_Click()
  Dim aa As String, bb As String
  aa = "苹果 香蕉 桔子 西瓜"
  bb = "辣椒2 ,,,苹果1... 西瓜2;;; 桔子3 苹果2 香蕉4 西瓜5 番茄6 桔子12"
  MsgBox Vegetables(aa, bb)
End Sub

运行结果如下：

苹果3 香蕉4 桔子15 西瓜7 没有的品种:辣椒 番茄

这样的代码，逻辑清楚，代码简洁，值得推荐