Tách chuỗi bằng code VBA

thao nguyen01

Thành viên chính thức
Tham gia ngày
8 Tháng mười hai 2019
Bài viết
81
Được thích
8
Điểm
20
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 ạ.
 

File đính kèm

Sharava36

---)III(---
Tham gia ngày
6 Tháng năm 2016
Bài viết
370
Được thích
161
Điểm
195
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 ạ.
Cái này dung hàm có sẵn cũng được mà bạn
 

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,411
Được thích
4,230
Điểm
560
Nơi ở
Hải Phòng
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 ạ.
Bạn thử:
PHP:
Sub Test()
    Dim Cll As Range
    For Each Cll In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Cll.Offset(, 1).Value = Replace(Replace(Replace(Split(Cll.Value, ":")(0), "CCCD", ""), "CMND", ""), ",", "")
        Cll.Offset(, 2).Value = Split(Cll.Value, ":")(1)
    Next Cll
End Sub
 

File đính kèm

vulunktheky

Thành viên hoạt động
Tham gia ngày
2 Tháng ba 2018
Bài viết
164
Được thích
43
Điểm
170
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 ạ.
Nếu dữ liệu của bạn tổ chức 1 cách thống nhất thì có thể sử dụng chức năng Text to columns 2 lần. Nhanh gọn mà không cần tới công thức hay VBA
1585194178234.png
1585194145606.png
View attachment 234066View attachment 234067
 

thao nguyen01

Thành viên chính thức
Tham gia ngày
8 Tháng mười hai 2019
Bài viết
81
Được thích
8
Điểm
20
Nếu dữ liệu của bạn tổ chức 1 cách thống nhất thì có thể sử dụng chức năng Text to columns 2 lần. Nhanh gọn mà không cần tới công thức hay VBA
View attachment 234069
View attachment 234068
View attachment 234066View attachment 234067
Dạ, em cảm ơn ạ.
Bài đã được tự động gộp:

Bạn thử:
PHP:
Sub Test()
    Dim Cll As Range
    For Each Cll In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Cll.Offset(, 1).Value = Replace(Replace(Replace(Split(Cll.Value, ":")(0), "CCCD", ""), "CMND", ""), ",", "")
        Cll.Offset(, 2).Value = Split(Cll.Value, ":")(1)
    Next Cll
End Sub
Dạ, em cảm ơn ạ. Nhưng khi em chạy code Ví dụ: CCCD: 027071123078, thì khi chạy xong thiếu mất số 0 ở đầu ạ. Anh/chị có thể xem giúp em với ạ. Em cảm ơn ạ.
 

Sharava36

---)III(---
Tham gia ngày
6 Tháng năm 2016
Bài viết
370
Được thích
161
Điểm
195
Mình chọt chẹt them 1 cách. Bạn tham khảo
PHP:
Sub Tachdulieu()
    Dim sRng As Range, rng As Range
    Dim sArr(), dArr(), I As Long, K As Long
    On Error GoTo Thoat
    Set sRng = Application.InputBox(Prompt:="chon vung du lieu ", Title:="Chon du lieu dau vao", Type:=8)
    sArr = sRng.Value
    ReDim dArr(1 To UBound(sArr), 1 To 2)
    For I = 1 To UBound(sArr)
        If sArr(I, 1) <> Empty Then
            sArr(I, 1) = Replace(sArr(I, 1), ",", ""):    sArr(I, 1) = Replace(sArr(I, 1), ";", "")
            sArr(I, 1) = Replace(sArr(I, 1), "CMND", ""):    sArr(I, 1) = Replace(sArr(I, 1), "CCCD", "")
            K = K + 1
            On Error Resume Next
            dArr(K, 1) = Split(sArr(I, 1), ":")(0): dArr(K, 2) = Split(sArr(I, 1), ":")(1)
        End If
    Next I
    Set rng = Application.InputBox(Prompt:="Chon o chua ket qua", Title:="Chon o", Type:=8)
    rng.Resize(K, 2) = dArr
Thoat:
End Sub
 

File đính kèm

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
926
Được thích
924
Điểm
360
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 ạ.
Thử code dưới đây
Mã:
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
        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))
    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

Thành viên chính thức
Tham gia ngày
8 Tháng mười hai 2019
Bài viết
81
Được thích
8
Điểm
20
Mình chọt chẹt them 1 cách. Bạn tham khảo
PHP:
Sub Tachdulieu()
    Dim sRng As Range, rng As Range
    Dim sArr(), dArr(), I As Long, K As Long
    On Error GoTo Thoat
    Set sRng = Application.InputBox(Prompt:="chon vung du lieu ", Title:="Chon du lieu dau vao", Type:=8)
    sArr = sRng.Value
    ReDim dArr(1 To UBound(sArr), 1 To 2)
    For I = 1 To UBound(sArr)
        If sArr(I, 1) <> Empty Then
            sArr(I, 1) = Replace(sArr(I, 1), ",", ""):    sArr(I, 1) = Replace(sArr(I, 1), ";", "")
            sArr(I, 1) = Replace(sArr(I, 1), "CMND", ""):    sArr(I, 1) = Replace(sArr(I, 1), "CCCD", "")
            K = K + 1
            dArr(K, 1) = Split(sArr(I, 1), ":")(0): dArr(K, 2) = Split(sArr(I, 1), ":")(1)
        End If
    Next I
    Set rng = Application.InputBox(Prompt:="Chon o chua ket qua", Title:="Chon o", Type:=8)
    rng.Resize(K, 2) = dArr
Thoat:
End Sub
Dạ, em cảm ơn ạ. Nhưng khi em chạy code bị vấn đề như trên ạ. Em Ví dụ: CCCD: 027071123078, thì khi chạy xong thiếu mất số 0 ở sub tachchuoi ạ. Anh xem giúp em ạ. Em cảm ơn ạ.
Bài đã được tự động gộp:

Thử code dưới đây
Mã:
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
        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))
    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 ạ.
 

Sharava36

---)III(---
Tham gia ngày
6 Tháng năm 2016
Bài viết
370
Được thích
161
Điểm
195
Dạ, em cảm ơn ạ. Nhưng khi em chạy code bị vấn đề như trên ạ. Em Ví dụ: CCCD: 027071123078, thì khi chạy xong thiếu mất số 0 ở sub tachchuoi ạ. Anh xem giúp em ạ. Em cảm ơn ạ.
Bạn thay dòng cũ bang dòng này thử
Mã:
dArr(K, 1) = Split(sArr(I, 1), ":")(0): dArr(K, 2) = "'" & Split(sArr(I, 1), ":")(1)
 

VetMini

Bàn phiếm qua bàn phím
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
8,240
Được thích
9,576
Điểm
560
Dạ, vì dữ liệu của em 1 tháng gần 10.000 dòng, 1 năm hơn 100.000 dòng, nên em dùng hàm sẽ chậm ạ.
Quản lý dữ klieeuj chừng này thì đi học một khoá quản lý đi.
Điẻn hình là học cách quản lý csdl. Nếu vẫn còn dùng Excel thì cần học PowerQuery và Powerpivot.

Cốt kiếc này nọ chỉ là đắp vá tạm thời.
 

thao nguyen01

Thành viên chính thức
Tham gia ngày
8 Tháng mười hai 2019
Bài viết
81
Được thích
8
Điểm
20
Bạn thay dòng cũ bang dòng này thử
Mã:
dArr(K, 1) = Split(sArr(I, 1), ":")(0): dArr(K, 2) = "'" & Split(sArr(I, 1), ":")(1)
Dạ, kết quả ra đúng ạ. Em cảm ơn anh ạ.
Bài đã được tự động gộp:

Quản lý dữ klieeuj chừng này thì đi học một khoá quản lý đi.
Điẻn hình là học cách quản lý csdl. Nếu vẫn còn dùng Excel thì cần học PowerQuery và Powerpivot.

Cốt kiếc này nọ chỉ là đắp vá tạm thời.
Dạ, em cảm ơn Thầy ạ. Vì dữ liệu nhiều, nhưng lúc nhập thì do nhiều bạn nhập nên có lúc dữ liệu không đồng nhất ạ. Sau này em có thống nhất lại nhưng đôi lúc vẫn gặp tình trạng như trên ạ. Em sẽ tìm hiểu và học thêm những khóa ở trên ạ. Em cảm ơn Thầy nhiều ạ.
 

thao nguyen01

Thành viên chính thức
Tham gia ngày
8 Tháng mười hai 2019
Bài viết
81
Được thích
8
Điểm
20
Flash Fill 1 triệu dòng cỡ hơn 1 nửa cái nháy mắt.
Dạ, em cảm ơn các anh/chị đã giúp đỡ em giải quyết những khó khăn của em ở trên ạ. Sau khi em làm với dữ liệu của mình thì em vướng vấn đề nữa là: Nội dung có tên và Chứng minh thì sẽ tách thành cột tên và cột Chứng minh ạ. Còn nội dung chỉ có cột tên thì chỉ điền vào cột tên, cột Chứng minh để trống ạ. Em có dùng Flash Fill thì bị vướng ở cột chỉ có tên ạ. Em có mô tả trong file ạ. Anh/chị xem giúp em ạ. Em cảm ơn anh/chị ạ.
 

File đính kèm

congnguyen88

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia ngày
22 Tháng bảy 2014
Bài viết
356
Được thích
29
Điểm
385
Tuổi
30
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 ạ.
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:

Quản lý dữ klieeuj chừng này thì đi học một khoá quản lý đi.
Điẻn hình là học cách quản lý csdl. Nếu vẫn còn dùng Excel thì cần học PowerQuery và Powerpivot.

Cốt kiếc này nọ chỉ là đắp vá tạm thời.
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
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
8,833
Được thích
8,528
Điểm
560
Tuổi
62
Nơi ở
Biên Hòa, Đồng Nai
Dạ, em cám ơn anh trước.
Thử lại code sau:

Mã:
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
 
Top Bottom