!
Dữ liệu của bạn không đồng nhất nên khó cho kết quả chính xác.Mình có khoảng hơn 1000 Khách hàng mà muốn tách riêng ra thành 2 côt
địa chỉ và tỉnh thành mà không làm thế nào được !
Mong các bạn giúp đỡ
Cảm ơn bạn nhé
Nhưng không còn cách nào khác nữa sao bạn ơi ! mình chỉ coppy 1000 Khách hàng thôi chứ thực ra mình có 90.700 cơ thế này chắc mình chết rồi
Option Explicit
Sub TachDC()
On Error Resume Next
Const Ph As String = ","
Dim Clls As Range, VTr As Byte, Sh As Worksheet
Set Sh = Sheets("KQ"): Sheet1.Select
Sh.[B1].CurrentRegion.Offset(1).ClearContents
For Each Clls In Range([A1], [A65500].End(xlUp))
With Sh.[A65500].End(xlUp).Offset(1)
VTr = InStr(Clls.Value, Ph)
If VTr > 0 Then
.Value = Left(Clls.Value, VTr - 1)
.Offset(, 1).Value = Mid(Clls.Value, VTr + 1)
End If
End With
Next Clls
End Sub
Mình viết OK hơi chung mà nhấn phím Replace All
Sub Addr_Split()
Dim Tam
Dim Rg1, Rg2, Cll As Range
Dim Tb1, Tb2, ch As String
Dim k, k1 As Long
On Error GoTo Thoat
k = 0: k1 = 0
Tb1 = "Chon vung du lieu can tach, co the chon ca cot: " & Chr(10) & "(Co the dung chuot quet vung du lieu)"
Tb2 = "SEALAND GPE"
Set Rg1 = Application.InputBox(Tb1, Tb2, , , , , , 8)
If Rg1.Columns.Count > 1 Then MsgBox "Chi chon 1 cot thoi! De nghi chon lai.": Exit Sub
Tb1 = "Chon o dau tien cua cot dich: " & Chr(10) & "(Co the dung chuot de chon)"
Set Rg2 = Application.InputBox(Tb1, Tb2, , , , , , 8)
For Each Cll In Rg1.Cells
If Cll.Text <> "" Then
ch = Replace(Cll.Text, "-", ",")
Tam = Split(ch, ",")
Rg2.Offset(k) = Tam(0)
k1 = k1 + 1
End If
k = k + 1
Next
MsgBox "Da tach tong so " & Format(k1, "#,##0") & " dia chi."
Thoat:
Exit Sub
End Sub
