Chia chuỗi ký tự

[tuan16]

Em muốn chia chuỗi ký tự thành nhiều chuỗi khác nhau có độ dài các chuỗi tối đa là 106 ký tự. Em xin nhờ các anh chị trong diễn đàn giúp ạ

 

[Phuocam]

Bạn sử dụng UDF:

Public Function TachChuoi(ByVal s As String, ByVal SoTu As Long, ByVal SoThuTu As Long) As String
Dim arr() As Variant, k As Long
Dim Vitri As Long
SoTu = SoTu + 1
Do While Len(s) > 0
    k = k + 1
    ReDim Preserve arr(1 To k)
    Vitri = VBA.InStrRev(s, " ", SoTu)
    If Vitri > 0 Then
        arr(k) = VBA.Left(s, Vitri - 1)
        s = VBA.Mid(s, Vitri + 1)
    Else
        arr(k) = s
        s = ""
    End If
Loop
If SoThuTu <= k Then TachChuoi = arr(SoThuTu)
End Function

Xem thêm tại đây: https://www.giaiphapexcel.com/diend...-theo-số-ký-tự-tương-ứng.157858/#post-1048125

 

[tuan16]

Bạn sử dụng UDF:

Public Function TachChuoi(ByVal s As String, ByVal SoTu As Long, ByVal SoThuTu As Long) As String
Dim arr() As Variant, k As Long
Dim Vitri As Long
SoTu = SoTu + 1
Do While Len(s) > 0
    k = k + 1
    ReDim Preserve arr(1 To k)
    Vitri = VBA.InStrRev(s, " ", SoTu)
    If Vitri > 0 Then
        arr(k) = VBA.Left(s, Vitri - 1)
        s = VBA.Mid(s, Vitri + 1)
    Else
        arr(k) = s
        s = ""
    End If
Loop
If SoThuTu <= k Then TachChuoi = arr(SoThuTu)
End Function

Xem thêm tại đây: https://www.giaiphapexcel.com/diendan/threads/hỗ-trợ-tách-địa-chỉ-thành-nhiều-cột-theo-số-ký-tự-tương-ứng.157858/#post-1048125

dạ em cảm ơn anh đã giúp ạ

 

[Vô danh Tiểu tốt]

Tôi tạo ra một hàm trả về mảng phân tách. Ý tưởng giải quyết không khó thế mà lúc làm phát sinh nhiều lỗi phết. Có một vấn đề là nếu xuất hiện một chữ có độ dài vượt trội thì kết quả không hay lắm với cả hai.

Function Ws(text As String, max_length As Long) As String()
    Dim b, c As Long
    Dim t, teo() As String
    b = 1
    Do
        t = Mid(text, b, max_length + 1)
        If Right(t, 1) <> " " And Len(t) = max_length + 1 Then
            t = Left(t, InStrRev(t, " "))
        End If
        b = Len(t) + b
        c = c + 1
        ReDim Preserve teo(c)
        teo(c) = Trim(t) ': Debug.Print teo(c)
    Loop While b < Len(text) And Len(t)
    Ws = teo
End Function

Sub t()
    Dim text As String
    text = "Tr??c khi ti?n hàwwghh          thi công, nhà th?u xây l?p ?ã báo cáo bi?n pháp thi công và ???c ch? ??u t?, TVGS "
    Debug.Print Ws(text, 21)(3)
End Sub