Tách chuỗi bằng code VBA

[thao nguyen01]

Kính gửi anh/chị trên diễn đàn,

Em đang bị vướng về vấn đề tách chuỗi ạ. Em muốn tách tên và chứng minh nhân dân từ cột A ạ. Em có mô tả trong file đính kèm. Anh/chị xem giúp em với ạ. Em cảm ơn ạ.

 

[thao nguyen01]

Lọc lấy những dòng có đủ họ tên và số CMND rồi làm.

Dạ, hôm qua em có chạy Flash Fill sau đó lọc bỏ chọn những dòng ở cột C là tên mà không phải là số, nhưng do dữ liệu hơi nhiều nên việc bỏ lọc khá mất thời gian ạ. Do em bỏ lọc bằng cách làm thủ công ạ.

Bài đã được tự động gộp: 29/3/20

sau khi so sánh từng câu chử. có thể đoán là thành viên này 80%. do bị khóa nick
hiénlinh197
là 1 nhé mọi người. Khóa ních kia thì nó tạo nick này. Vì nó đang muốn tách đoạn tin nhắn đánh đề đó. cẩn thận

Bài đã được tự động gộp: 28/3/20

không phải. Khi người ta đánh đề người ta nhắn tin kiểu nội dung là vậy. bây giờ phải nhờ Excel tách ra

Dạ, anh @congnguyen88 anh nói sau khi nick hiénlinh197 kia bị khóa, thì tạo nick này. Anh có xem thời gian em tham gia không ạ? Khi anh nói em phải xem lại vì không hiểu chuyện gì nữa. Em tham gia ngày 08/12/2019, còn em nhớ nick anh nói mới bị đình chỉ vào ngày 26/03/2020 ạ? Sao anh nói như vậy anh? Và nếu em thực sự không phải thì như thế nào anh?

Em hy vọng rằng sau này trước khi anh nói, anh sẽ suy nghĩ và thật sự chắc chắn một vấn đề gì đó anh hãy nói ra anh nhé. Vì nếu thực sự không phải, anh đã làm ảnh hưởng đến danh dự và nhân phẩm của người khác ạ. Em cảm ơn anh.

Bài đã được tự động gộp: 29/3/20

Thử lại code sau:

Sub TachDuLieu()
    Dim xCell As Range: Dim Vung As Object
    Set Vung = Range("A2", Range("A6000").End(xlUp))
    For Each xCell In Vung
        xCell.Offset(, 1).Value = Replace(Replace(Replace(Split(xCell.Value, ":")(0), "CCCD", ""), "CMND", ""), ",", "")
        xCell.Offset(, 2).Value = "'" & Split(xCell.Value, ":")(1)
    Next xCell
End Sub

Dạ, khi em chạy code thì báo lỗi Subscript out of range ạ.

xCell.Offset(, 2).Value = "'" & Split(xCell.Value, ":")(1)

Nếu có thể, anh xem giúp em với ạ. Em cảm ơn anh

 

[be_09]

Dạ, khi em chạy code thì báo lỗi Subscript out of range ạ.

xCell.Offset(, 2).Value = "'" & Split(xCell.Value, ":")(1)

Nếu có thể, anh xem giúp em với ạ. Em cảm ơn anh

Xem File.

 

[thao nguyen01]

Xem File.

Dạ, em cảm ơn anh ạ. Vấn đề em gặp phải là khi data của em có cả tên và nội dung thì code chạy đúng ạ. Nhưng vì trong phần nội dung của em có nhiều khi chỉ có tên, không có chứng minh. Lúc đó code sẽ báo lỗi dòng
xCell.Offset(, 2).Value = "'" & Split(xCell.Value, ":")(1)
Em chưa biết xử lý như thế nào đối với nội dung chỉ có tên ạ. Em cảm ơn anh đã giúp em ạ.

 

[CHAOQUAY]

Dạ, em cảm ơn anh ạ. Vấn đề em gặp phải là khi data của em có cả tên và nội dung thì code chạy đúng ạ. Nhưng vì trong phần nội dung của em có nhiều khi chỉ có tên, không có chứng minh. Lúc đó code sẽ báo lỗi dòng
xCell.Offset(, 2).Value = "'" & Split(xCell.Value, ":")(1)
Em chưa biết xử lý như thế nào đối với nội dung chỉ có tên ạ. Em cảm ơn anh đã giúp em ạ.

Sub Tach()
Dim Nguon
Dim Kq() As String
Dim i, j, k, rws
With Sheet1
    rws = .Range("A1").End(xlDown).Row
    Nguon = .Range("A2:A" & rws)
    ReDim Kq(1 To rws - 1, 1 To 2)
    For i = 1 To rws - 1
        If IsNumeric(Right(Nguon(i, 1), 1)) = True Then
            Nguon(i, 1) = Replace(Nguon(i, 1), ",", "")
            k = InStr(Nguon(i, 1), ":")
            Kq(i, 2) = Trim(Mid(Nguon(i, 1), k + 1, 100))
            k = InStrRev(Left(Nguon(i, 1), k - 1), " ")
            Kq(i, 1) = Trim(Left(Nguon(i, 1), k - 1))
        Else
            Kq(i, 1) = Nguon(i, 1)
        End If
    Next i
    .Range("B2").Resize(UBound(Kq), UBound(Kq, 2)).ClearContents
    .Range("B2").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub

 

[thao nguyen01]

Sub Tach()
Dim Nguon
Dim Kq() As String
Dim i, j, k, rws
With Sheet1
    rws = .Range("A1").End(xlDown).Row
    Nguon = .Range("A2:A" & rws)
    ReDim Kq(1 To rws - 1, 1 To 2)
    For i = 1 To rws - 1
        If IsNumeric(Right(Nguon(i, 1), 1)) = True Then
            Nguon(i, 1) = Replace(Nguon(i, 1), ",", "")
            k = InStr(Nguon(i, 1), ":")
            Kq(i, 2) = Trim(Mid(Nguon(i, 1), k + 1, 100))
            k = InStrRev(Left(Nguon(i, 1), k - 1), " ")
            Kq(i, 1) = Trim(Left(Nguon(i, 1), k - 1))
        Else
            Kq(i, 1) = Nguon(i, 1)
        End If
    Next i
    .Range("B2").Resize(UBound(Kq), UBound(Kq, 2)).ClearContents
    .Range("B2").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub

Dạ, Kết quả ra đúng rồi ạ. Em cảm ơn anh nhiều ạ.

 

[befaint]

Dạ, hôm qua em có chạy Flash Fill sau đó lọc bỏ chọn những dòng ở cột C là tên mà không phải là số, nhưng do dữ liệu hơi nhiều nên việc bỏ lọc khá mất thời gian ạ. Do em bỏ lọc bằng cách làm thủ công ạ.

Lọc phân loại trước rồi mới Flash Fill. Chứ không làm ngược thế kia.

 

[thao nguyen01]

Lọc phân loại trước rồi mới Flash Fill. Chứ không làm ngược thế kia.

Dạ, em hiểu rồi ạ. Em cảm ơn anh ạ.