Tách 1 chuỗi thành 2 chuỗi dài tương đương nhau (độ dài chênh lệch nhau ít nhất) ?

[ChanhTQ@]

Bài này mình nghĩ đâu cần vòng lặp làm gì. Chỉ cần 1 cái If Else là xong thôi

Đâu Hải thử với chuỗi này xem sao:

http://www.giaiphapexcel.com/forum/...g-nhau-(độ-dài-chênh-lệch-nhau-ít-nhất)/page2 GPE.COM 1

 

[siwtom]

Bài này mình nghĩ đâu cần vòng lặp làm gì. Chỉ cần 1 cái If Else là xong thôi

Nếu dị ứng với FOR thì

Function ChiaChuoi(ByVal s As String)
Dim Arr(1 To 2) As String, pos As Long, pos1 As Long, pos2 As Long
    s = WorksheetFunction.Trim(s)
    pos = Len(s) \ 2
    [COLOR=#ff0000]If Mid(s, pos, 1) <> " " Then[/COLOR]
        pos1 = InStrRev(s, " ", pos)
        pos2 = InStr(pos, s, " ")
        If Len(s) + 1 <= pos1 + pos2 Then
            pos = pos1
        Else
            pos = pos2
        End If
    [COLOR=#ff0000]End If[/COLOR]
    Arr(1) = Left(s, pos - 1)
    Arr(2) = Mid(s, pos + 1, Len(s))
    ChiaChuoi = Arr
End Function

Thực ra có thể bỏ cái IF ngoài (đỏ đỏ) và chỉ cần 1 IF theo yêu cầu khán giả

 

[VetMini]

Đúng là bài này không cần dùng vòng lặp.
(*) tôi có lý do tại sao tôi thích dùng vòng lặp để duyệt chuỗi. Nhưng lý do đó không quan trọng lắm đới với VBA và lại càng không quan trọng trong trường hợp này.

=== bổ sung ===
@siwtom: code trên cần thêm phần bẫy lỗi chuỗi đặc không có khoảng trống nào cả. (cho ra "#VALUE!" nếu chuỗi là "aa")

 

[Quang_Hải]

Nếu dị ứng với FOR thì

Function ChiaChuoi(ByVal s As String)
Dim Arr(1 To 2) As String, pos As Long, pos1 As Long, pos2 As Long
    s = WorksheetFunction.Trim(s)
    pos = Len(s) \ 2
    [COLOR=#ff0000]If Mid(s, pos, 1) <> " " Then[/COLOR]
        pos1 = InStrRev(s, " ", pos)
        pos2 = InStr(pos, s, " ")
        If Len(s) + 1 <= pos1 + pos2 Then
            pos = pos1
        Else
            pos = pos2
        End If
    [COLOR=#ff0000]End If[/COLOR]
    Arr(1) = Left(s, pos - 1)
    Arr(2) = Mid(s, pos + 1, Len(s))
    ChiaChuoi = Arr
End Function

Thực ra có thể bỏ cái IF ngoài (đỏ đỏ) và chỉ cần 1 IF theo yêu cầu khán giả

Em viết cũng ra kết quả nhưng nhìn có vẻ lu xu bu quá

Function Tach(ByVal s As String) As String
Dim Tmp1, Tmp2
Tmp1 = Left(s, Len(s) \ 2 + 1)
Tmp2 = Right(s, Len(s) \ 2 + 1)
If Len(Tmp1) - InStrRev(Tmp1, " ") >= InStr(Tmp2, " ") Then
   Tach = Trim(Left(s, Len(Tmp1) + InStr(Tmp2, " ") - 2))
Else
   Tach = Trim(Left(Tmp1, InStrRev(Tmp1, " ")))
End If
End Function

 

[VetMini]

Theo phép tính điểm giữa, (Len(s) + 1) \ 2 mới là điểm giữa thật.
Tôi chọn Len(s) \ 2 + 1 là vì theo cách tính đếm (vòng lặp) thì cách này sẽ ưu tiên cho chuỗi thứ nhất ("aa b cc" cho ra chuỗi thứ nhất là "aa b")

Cách tính của bạn chọn ưu tiên cho chuỗi thứ hai ("aa b cc" cho ra chuỗi thứ nhất là "aa")

Tôi không nói kiểu nào hay hơn kiểu nào. Chỉ đưa ra các điểm cho bạn nào muốn dùng thì phải biết các điều kiện.

 

[siwtom]

=== bổ sung ===
@siwtom: code trên cần thêm phần bẫy lỗi chuỗi đặc không có khoảng trống nào cả. (cho ra "#VALUE!" nếu chuỗi là "aa")

He he, cám ơn bạn. Đêm khuya quá nên không để ý thấy là trứng thối, cà chua thối bay vèo vèo lên sân khấu.

Chỉ xin tình tiết giảm nhẹ là sâu trong đêm nên cái đầu đã lên giường từ lâu rồi.

Có lẽ bây giờ là chuẩn. Trả về 2 chuỗi rỗng nếu không thể chia được (chuỗi đặc, chuỗi rỗng)

Function ChiaChuoi(ByVal s As String)
Dim Arr(1 To 2) As String, pos As Long, pos1 As Long, pos2 As Long
    Arr(1) = ""
    Arr(2) = ""
    If s <> "" Then
        s = WorksheetFunction.Trim(s)
        pos = Len(s) \ 2
        pos1 = InStrRev(s, " ", pos)
        pos2 = InStr(pos, s, " ")
        If pos2 = 0 Then
            pos = pos1
        ElseIf Len(s) + 1 <= pos1 + pos2 Then
            pos = pos1
        Else
            pos = pos2
        End If
        If pos <> 0 Then
            Arr(1) = Left(s, pos - 1)
            Arr(2) = Mid(s, pos + 1, Len(s))
        End If
    End If
    ChiaChuoi = Arr
End Function

-------------
tb.
Nếu chuỗi "đặc", tức không có khoảng trống, thì trả về lỗi hoặc chuỗi rỗng vì không có khoảng trống để "cắt".

Nhưng công thức của bạn huuthang_bd và code của bạn VetMini đều trả về cả chuỗi "đặc" cho 1 trong 2 chuỗi. Như vậy cũng không đúng.

Công thức của bạn VMH0307 trả về lỗi cho chuỗi đặc "xyz" (có lý) nhưng cũng trả về lỗi cho chuỗi "a abcd". Như thế là sai. Kết quả phải là "a" và "abcd" vì cách chia duy nhất cũng là cách chia thỏa đk MIN trong các cách chia.

Code của bạn quanghai1969 thì luôn chỉ trả về 1 chuỗi duy nhất. Thế còn chuỗi kia?

 

[huuthang_bd]

Nhưng công thức của bạn huuthang_bd và code của bạn VetMini đều trả về cả chuỗi "đặc" cho 1 trong 2 chuỗi. Như vậy cũng không đúng.

Vì chủ topic không nói rõ trong trường hợp chuỗi không có khoản trắng nên cũng không biết thế nào mới là "đúng" theo ý chủ topic. Theo em thì sau khi tách ra thì ghép 2 chuỗi kết quả phải bằng chuỗi ban đầu mới đúng nên chuỗi không có khoản trắng thì dồn hết về 1 chuỗi của kết quả.

He he, cám ơn bạn. Đêm khuya quá nên không để ý thấy là trứng thối, cà chua thối bay vèo vèo lên sân khấu.

Chỉ xin tình tiết giảm nhẹ là sâu trong đêm nên cái đầu đã lên giường từ lâu rồi.

Có lẽ bây giờ là chuẩn. Trả về 2 chuỗi rỗng nếu không thể chia được (chuỗi đặc, chuỗi rỗng)

Code của anh còn bị lỗi nếu chỗi là một ký tự không phải khoản trắng . Với lại em nghĩ mảng Arr đã khai báo kiểu String nên không cần phải gán chuỗi rỗng cho các phần tử.
Mạng phép sửa lại code anh một chút như thế này (vẫn theo nguyên tắc chuỗi "đặc" thì trả trề 2 chuỗi rỗng)

Function ChiaChuoi(ByVal S As String)
Dim Arr(1 To 2) As String, Pos As Long
S = WorksheetFunction.Trim(S)
If InStr(S, " ") > 0 Then
    Pos = InStrRev(S, " ", Len(S) \ 2)
    Pos = InStr(Mid(S, Pos + 1, Len(S) - Pos * 2), " ") + Pos
    Arr(1) = Left(S, Pos - 1)
    Arr(2) = Mid(S, Pos + 1, Len(S))
End If
ChiaChuoi = Arr
End Function