在一個多行的textbox中,字符相同的行只保留一行,但數量增加.

Question

一個textbox,有多行字符,如:801-116B5-PSAL01BO 4
                          141-116BX-001A-C041 3
                          141-119BX-002A-C041 2
                          801-116B5-PSAL01BO 1
                          141-119BX-002A-C041 1
                          143-118XX-001A-C010 3
                          151-119BX-001A-C041 1
                          321-280SA-3250TR1 1
                          141-116BX-001A-C041 2
                          143-117AX-001A-0000 2
                          151-119BX-001A-C041 1
每一行的最後一個字符是數量,前部分是編號.
請問如果我要把編號相同的行只保留一行,而它們后面的數量相加.應該怎樣做呢?
就是說當文本框的容為上面內容時,點擊按扭,就變為
                          801-116B5-PSAL01BO 5
                          141-116BX-001A-C041 5
                          141-119BX-002A-C041 3
                          143-118XX-001A-C010 3
                          151-119BX-001A-C041 2
                          321-280SA-3250TR1 1
                          143-117AX-001A-0000 2
明白我的意思嗎?
請各位vb高手多幫忙!!
                         

Answer 1

Private Sub Command1_Click()
    'textbox1输入,textbox2输出显示
    Dim ArrStr
    Dim arrChastr() As String
    Dim tmpArr
    Dim i As Integer
    Dim j As Integer
    ArrStr = Split(Text1.Text, vbCrLf)
    ReDim arrChastr(UBound(ArrStr), 2)
    For i = 0 To UBound(ArrStr)
        tmpArr = Split(Trim(ArrStr(i)), Chr(9))
        
        If UBound(tmpArr) <= 0 Then Exit For
        
        arrChastr(i, 0) = tmpArr(0)
        arrChastr(i, 1) = tmpArr(UBound(tmpArr))
        arrChastr(i, 2) = 1
    Next i
    ReDim arrtxtcontent(UBound(ArrStr), 1)
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
                For j = i + 1 To UBound(ArrStr)
                    If arrChastr(j, 2) <> "" Then
                        If arrChastr(i, 0) = arrChastr(j, 0) And arrChastr(j, 2) = 1 Then
                            arrChastr(i, 1) = CInt(arrChastr(i, 1)) + CInt(arrChastr(j, 1))
                            arrChastr(j, 2) = 2
                        End If
                    End If
                Next j
            End If
        End If
    Next i
    
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
                Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) + " " + CStr(arrChastr(i, 1))
            End If
        End If
    Next i
End Sub临时写的,有些不完善,再改改吧

Answer 2

如果可以，建议使用ListBox这样处理起来要方便多了

Answer 3

danielinbiti(金) 真棒!
再問一下那個中間空開的為什麼是chr(9)?
chr(9)是什麼字符?

Answer 4

快點啦，我現在因為這個編號的長短不一，所以在給text2賦值的時候，用danielinbiti(金）的這句Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) + " 　" + CStr(arrChastr(i, 1))
就會出現無法對整齊的現象，結果為
021-116BX-01AGS  1
365-RR050-040011  1
602-116B-001A  1
802-116B5-PSAL01BO  1
171-116B5-001A-TT01  1
171-116B5-002A-WE01  1
171-116B5-003A-WE01  1
172-117XX-001A-PK01  1
501-01100-02001A  4
701-30100-0PT201  4
804-116B5-PSAL1500  1
831-113XX-01APK01  1
181-113XX-002A-C010  1
而現在我把那句換成
Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) +chr(9) + CStr(arrChastr(i, 1))
就出現下面結果：
021-116BX-01AGS 1
365-RR050-040011 1
602-116B-001A 1
802-116B5-PSAL01BO 1
171-116B5-001A-TT01 1
171-116B5-002A-WE01 1
171-116B5-003A-WE01 1
172-117XX-001A-PK01 1
501-01100-02001A 4
701-30100-0PT201 4
804-116B5-PSAL1500 1
831-113XX-01APK01 1
181-113XX-002A-C010 1
到底要如何才可讓數量排成整齊的一排呢？快點幫忙啊，我要散分啦！

Answer 5

'粘这个代码试一下吧.Private Sub Command1_Click()
    Dim templ As Long
    Dim ArrStr
    Dim arrChastr() As String
    Dim tmpArr
    Dim i As Integer
    Dim j As Integer
    ArrStr = Split(Text1.Text, vbCrLf)
    ReDim arrChastr(UBound(ArrStr), 2)
    For i = 0 To UBound(ArrStr)
        tmpArr = Split(Trim(ArrStr(i)), Chr(9))
        
        If UBound(tmpArr) <= 0 Then Exit For
        
        arrChastr(i, 0) = tmpArr(0)
        arrChastr(i, 1) = tmpArr(UBound(tmpArr))
        arrChastr(i, 2) = 1
    Next i
    ReDim arrtxtcontent(UBound(ArrStr), 1)
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
                For j = i + 1 To UBound(ArrStr)
                    If arrChastr(j, 2) <> "" Then
                        If arrChastr(i, 0) = arrChastr(j, 0) And arrChastr(j, 2) = 1 Then
                            arrChastr(i, 1) = CInt(arrChastr(i, 1)) + CInt(arrChastr(j, 1))
                            arrChastr(j, 2) = 2
                        End If
                    End If
                Next j
            End If
        End If
    Next i
    
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
                If Len(arrChastr(i, 0)) > templ Then templ = Len(arrChastr(i, 0))
            End If
        End If
    Next i
    
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
                Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) & Space(templ - Len(arrChastr(i, 0)) + 4) + "" + CStr(arrChastr(i, 1))
            End If
        End If
    Next i
End Sub

Answer 6

Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) + Chr(9) + CStr(arrChastr(i, 1))

Answer 7

用Text2.Text = Text2.Text & vbCrLf & arrChastr(i, 0) +chr(9) + CStr(arrChastr(i, 1))
結果為
021-116BX-01AGS 1
365-RR050-040011 1
602-116B-001A 1
802-116B5-PSAL01BO 1
171-116B5-001A-TT01 1
171-116B5-002A-WE01 1
171-116B5-003A-WE01 1
172-117XX-001A-PK01 1
501-01100-02001A 4
701-30100-0PT201 4
804-116B5-PSAL1500 1
831-113XX-01APK01 1
181-113XX-002A-C010 1
用chr(9)，有時候隔得開有時候沒有那麼開，這個看來是與chr(9)前面的編號長度有關，但是絕不是字節數決定的。
應該怎樣解決呢？

Answer 8

^_^,好人做到底了,呵呵
Dim OutPutStr As String * 25
    For i = 0 To UBound(ArrStr)
        If arrChastr(i, 2) <> "" Then
            If arrChastr(i, 2) = 1 Then
               OutPutStr = Space(25)
               OutPutStr = arrChastr(i, 0)
               Text2.Text = Text2.Text & vbCrLf & OutPutStr + Chr(9) + CStr(arrChastr(i, 1))
                
            End If
        End If
    Next i

Answer 9

謝謝,特別謝謝 danielinbiti(金)，我還一直不知道在定義類型的時候定義長度會有這種好處，從來沒定義過長度。又學到一點了。