Hỗ trợ tách địa chỉ thành nhiều cột, theo số ký tự tương ứng

[Nguyenhoangphong0902]

Chào anh chị, em có bài thực tế là tách địa chỉ để upload vào phần mềm.

Do mỗi vùng chỉ cho 40 ký tự vì thế:

Nếu địa chỉ 80 ký tự thì sẽ thành 2 cột, 40- 40

Nếu địa chỉ 120 ký tự thì sẽ thành 3 cột, 40- 40-40

Nếu địa chỉ 160 ký tự thì sẽ thành 4 cột, 40- 40-40 -40

Nếu địa chỉ 160 ký tự thì sẽ thành 5 cột, 40- 40-40 -40-40

Có 1 cái khó là Ví dụ

202/8 Nguyễn Xí, Phường 26, Quận Bình Thạnh, TP Hồ Chí Minh

Địa chỉ này nếu lấy 40 ký tự thì sẽ là 202/8 Nguyễn Xí, Phường 26, Quận Bình Th

Nhưng địa chỉ này lại cắt đôi chữ thì không được, lúc đó mình phải lùi lại vị trí tới chữ "Bình" thôi.



Nói chung là không được cắt đôi chữ, không được có trường hợp bắt đầu bằng dấu phẩy hoặc dấu chấm

VD: cột 1 mình cắt tới chữ Quận Tân Bình, cột 2: , TP Hồ Chí Minh, thì vị trí cột 2 đã bắt đầu là dấu phẩy, vậy là sai. Lúc đó thì: cột 1 mình lấy tới chữ Tân thui, còn cột 2 : Bình, TP Hồ Chí Minh

Chỉ có 2 quy tắc đó thôi, Nhờ anh chị hỗ trợ giúp em. Cảm ơn anh chị

 

[Maika8008]

Code cho bạn:

Sub Split_Address()
Dim arr, arrRsl, arrSp
Dim i&, j&, k&, iMax&
Const kt = 40
arr = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim arrRsl(1 To UBound(arr), 1 To 8)
k = 1
For i = 1 To UBound(arr)
    arrSp = Split(arr(i, 1), " ")
    For j = 0 To UBound(arrSp)
D1:     arrRsl(i, k) = arrRsl(i, k) & arrSp(j) & " "
        If Len(Trim(arrRsl(i, k))) > kt Then
            arrRsl(i, k) = Trim(Left(arrRsl(i, k), Len(arrRsl(i, k)) - Len(arrSp(j)) - 1))
            k = k + 1
            If iMax < k Then iMax = k
            GoTo D1
        End If
    Next
    k = 1
Next
Sheet1.Range("B2").Resize(UBound(arr), iMax) = arrRsl
End Sub

 

[Phuocam]

Chào anh chị, em có bài thực tế là tách địa chỉ để upload vào phần mềm.

Do mỗi vùng chỉ cho 40 ký tự vì thế:

Nếu địa chỉ 80 ký tự thì sẽ thành 2 cột, 40- 40

Nếu địa chỉ 120 ký tự thì sẽ thành 3 cột, 40- 40-40

Nếu địa chỉ 160 ký tự thì sẽ thành 4 cột, 40- 40-40 -40

Nếu địa chỉ 160 ký tự thì sẽ thành 5 cột, 40- 40-40 -40-40

Có 1 cái khó là Ví dụ

202/8 Nguyễn Xí, Phường 26, Quận Bình Thạnh, TP Hồ Chí Minh

Địa chỉ này nếu lấy 40 ký tự thì sẽ là 202/8 Nguyễn Xí, Phường 26, Quận Bình Th

Nhưng địa chỉ này lại cắt đôi chữ thì không được, lúc đó mình phải lùi lại vị trí tới chữ "Bình" thôi.



Nói chung là không được cắt đôi chữ, không được có trường hợp bắt đầu bằng dấu phẩy hoặc dấu chấm

VD: cột 1 mình cắt tới chữ Quận Tân Bình, cột 2: , TP Hồ Chí Minh, thì vị trí cột 2 đã bắt đầu là dấu phẩy, vậy là sai. Lúc đó thì: cột 1 mình lấy tới chữ Tân thui, còn cột 2 : Bình, TP Hồ Chí Minh

Chỉ có 2 quy tắc đó thôi, Nhờ anh chị hỗ trợ giúp em. Cảm ơn anh chị

Bạn dùng thử UDF sau:

Public Function TachDiaChi(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 TachDiaChi = arr(SoThuTu)
End Function

Cách dùng:

=TachDiaChi($A2,40,COLUMNS($B2:B2))

Trong đó tham số:

s : Chuỗi muốn tách

SoTu: Số ký tự muốn tách

SoThuTu: Vị trí của kết quả.

 

[Nguyenhoangphong0902]

Em đã làm được rồi ạ. Em xin cảm ơn các anh chị rất nhiều.