| 网站首页 | 业界新闻 | 群组 | 人才 | 技术文章 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 274 人关注过本帖
标题:如何让一个字符串按照另一个字符串的顺序排列
只看楼主 收藏
easonchou
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2017-10-12
结帖率:100%
  已结贴   问题点数:40  回复次数:6   
如何让一个字符串按照另一个字符串的顺序排列
数组a()是苹果 香蕉 桔子 西瓜
文本框输入 苹果1 西瓜2 桔子3 苹果2 香蕉4 西瓜5
怎么让文本框内容按照数组a的顺序排列,数字要跟在原来的文字后面,并且把重复项相加
输出结果是苹果3 香蕉4 桔子3 西瓜7

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

2017-10-28 09:35
easonchou
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2017-10-12
  得分:0 
我把文字和数字分别提取出来,单独作为数组,提取数字的时候,总提示类型错误
2017-10-28 09:37
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:186
帖 子:4059
专家分:25013
注 册:2008-10-15
  得分:15 
程序代码:
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


我按照我的思路写的

授人于鱼,不如授人于渔
早已停用QQ了
2017-10-28 10:19
ZHRXJR
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:52
帖 子:557
专家分:3178
注 册:2016-5-10
  得分:10 
用另一种方法也可以实现,仅供参考:
程序代码:
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

附件: 您没有浏览附件的权限,请 登录注册

QQ    2653043392
2017-10-28 16:59
booksoon
Rank: 2
等 级:论坛游民
威 望:3
帖 子:19
专家分:67
注 册:2017-10-30
  得分:0 
以下是引用ZHRXJR在2017-10-28 16:59:17的发言:

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    '以上得到正确的文本框的数组的值与最后一个数字

如果数字大于10呢?比如“苹果12”?
2017-10-30 11:16
wmf2014
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:120
帖 子:1570
专家分:8802
注 册:2014-12-6
  得分:15 
下述代码应该对楼主有用:
程序代码:
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 没有的品种:辣椒 番茄

能编个毛线衣吗?
2017-10-30 14:05
booksoon
Rank: 2
等 级:论坛游民
威 望:3
帖 子:19
专家分:67
注 册:2017-10-30
  得分:0 
回复 6楼 wmf2014
这样的代码,逻辑清楚,代码简洁,值得推荐
2017-10-30 14:28







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.087934 second(s), 8 queries.
Copyright©2004-2017, BCCN.NET, All Rights Reserved