Tách dữ liệu mã số đơn vị và tên đơn vị ra 02 cột bằng VBA

Trần Văn Bình · 21/5/24

Hiện mình có cột dữ liệu D2: D & Lr mình muốn tách dữ liệu cột này thành 02 cột kế tiếp.
Rất mong anh chị hỗ trợ vì đối tượng phân cách bởi phím Alt+enter.

Phuocam · 21/5/24

Trần Văn Bình đã viết:
Hiện mình có cột dữ liệu D2: D & Lr mình muốn tách dữ liệu cột này thành 02 cột kế tiếp
Rất mông anh chị hỗ trợ vì đối tượng phân cách bới phím Alt+enter

Mã số đơn vị gồm 10 số, bạn có thể dùng hàm LEFT để tách nó.

Trần Văn Bình · 21/5/24

Phuocam đã viết:
Mã số đơn vị gồm 10 số, bạn có thể dùng hàm LEFT để tách nó.

Mã rố đơn vị từ 2 đến 10 số bạn nên hơi khó

CHAOQUAY · 21/5/24

Trần Văn Bình đã viết:
Hiện mình có cột dữ liệu D2: D & Lr mình muốn tách dữ liệu cột này thành 02 cột kế tiếp
Rất mông anh chị hỗ trợ vì đối tượng phân cách bới phím Alt+enter

Chạy thử xem sao

Mã:

Option Explicit

Sub xxx()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k

Nguon = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

With CreateObject("VbScript.RegExp")
    .Pattern = "\d\D"
    For i = 1 To rws
        If .test(Nguon(i, 1)) Then
            k = .Execute(Nguon(i, 1))(0).firstindex
            Kq(i, 1) = Left(Nguon(i, 1), k + 1)
            Kq(i, 2) = Mid(Nguon(i, 1), k + 1, 1000000)
        End If
    Next i
End With

With Sheet1
    .Range("F2").Resize(rws, 2).Clear
    .Range("F2").Resize(rws, 2).NumberFormat = "@"
    .Range("F2").Resize(rws, 2) = Kq
    .Range("F2").Resize(rws, 2).Columns.AutoFit
End With

End Sub

Phuocam · 21/5/24

Trần Văn Bình đã viết:
Mã rố đơn vị từ 2 đến 10 số bạn nên hơi khó

Nếu độ dài khác nhau, có thể dùng:

=LEFT(D2,FIND(CHAR(10),D2)-1)

Trần Văn Bình · 21/5/24

CHAOQUAY đã viết:

Chạy thử xem sao

Mã:

Option Explicit

Sub xxx()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k

Nguon = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

With CreateObject("VbScript.RegExp")
    .Pattern = "\d\D"
    For i = 1 To rws
        If .test(Nguon(i, 1)) Then
            k = .Execute(Nguon(i, 1))(0).firstindex
            Kq(i, 1) = Left(Nguon(i, 1), k + 1)
            Kq(i, 2) = Mid(Nguon(i, 1), k + 1, 1000000)
        End If
    Next i
End With

With Sheet1
    .Range("F2").Resize(rws, 2).Clear
    .Range("F2").Resize(rws, 2).NumberFormat = "@"
    .Range("F2").Resize(rws, 2) = Kq
    .Range("F2").Resize(rws, 2).Columns.AutoFit
End With

End Sub

Nhờ bạn sữa giúp hiện chạy code tại cột G dư 1 số đứng đầu của dữ liệu

Phuocam · 21/5/24

Thử thay dòng: Kq(i, 2) = Mid(Nguon(i, 1), k + 1, 1000000)

Bằng: Kq(i, 2) = Mid(Nguon(i, 1), k + 2) ' hàm MID của VBA khi không có đối số thứ ba, nó sẽ lấy đến hết chuỗi.

hoặc: Kq(i, 2) = Mid(Nguon(i, 1), k + 3) ' Loại bỏ thêm char(10) , Alt+enter.

Trần Văn Bình · 21/5/24

Phuocam đã viết:
Thử thay dòng: Kq(i, 2) = Mid(Nguon(i, 1), k + 1, 1000000)

Bằng: Kq(i, 2) = Mid(Nguon(i, 1), k + 2) ' hàm MID của VBA khi không có đối số thứ ba, nó sẽ lấy đến hết chuỗi.

hoặc: Kq(i, 2) = Mid(Nguon(i, 1), k + 3) ' Loại bỏ thêm char(10) , Alt+enter.

Vẫn đang bị đơn vị Chi nhánh hoặc số có chữ ở giữa

Phuocam · 21/5/24

Trần Văn Bình đã viết:
Vẫn đang bị đơn vị Chi nhánh hoặc số có chữ ở giữa

Tách theo char(10) thử dùng code sau:

Mã:

Sub xyz()
Dim Nguon
Dim Kq
Dim rws&
Dim i&, arr

Nguon = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

    For i = 1 To rws
        arr = Split(Nguon(i, 1) & ChrW(10), ChrW(10))
            Kq(i, 1) = arr(0)
            Kq(i, 2) = arr(1)
    Next i


With Sheet1
    .Range("F2").Resize(rws, 2).Clear
    .Range("F2").Resize(rws, 2).NumberFormat = "@"
    .Range("F2").Resize(rws, 2) = Kq
    .Range("F2").Resize(rws, 2).Columns.AutoFit
End With

End Sub

Trần Văn Bình · 21/5/24

Phuocam đã viết:

Tách theo char(10) thử dùng code sau:

Mã:

Sub xyz()
Dim Nguon
Dim Kq
Dim rws&
Dim i&, arr

Nguon = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

    For i = 1 To rws
        arr = Split(Nguon(i, 1) & ChrW(10), ChrW(10))
            Kq(i, 1) = arr(0)
            Kq(i, 2) = arr(1)
    Next i


With Sheet1
    .Range("F2").Resize(rws, 2).Clear
    .Range("F2").Resize(rws, 2).NumberFormat = "@"
    .Range("F2").Resize(rws, 2) = Kq
    .Range("F2").Resize(rws, 2).Columns.AutoFit
End With

End Sub

Cám ơn bạn rất nhiều Code như mong muốn

cadafi · 21/5/24

Đối với bài toán của bạn, bạn có thể đặt hai Function như sau:

PHP:

Function GetCompanyCode(TgStr As String, TgChar As String) As String
Dim iPosition As Integer: iPosition = InStr(TgStr, TgChar)
If iPosition > 0 Then GetCompanyCode = Left(TgStr, iPosition)
End Function

và

PHP:

Function GetCompanyName(TgStr As String, TgChar As String) As String
Dim iPosition As Integer: iPosition = InStr(TgStr, TgChar)
If iPosition > 0 Then GetCompanyName = Right(TgStr, Len(TgStr) - iPosition)
End Function

Sau đó, có thể dùng tuỳ biến trên sheet, như data hiện có của bạn thì mình thấy ký tự ngăn cách là Char(10) (tương đương Alt+Enter), thì cú pháp là

PHP:

= GetCompanyCode(D2,Char(10))
= GetCompanyName(D2,Char(10))

Trong trường hợp data bạn dùng ký tự khác ngăn cách thì thay Char(10) bằng ký tự ngăn cách đó. Ví dụ:

PHP:

D2="3100771234-CÔNG TY TNHH DỊCH VỤ THƯƠNG MẠI ĐIỆN TỬ VATOTA"
B2 = GetCompanyCode(D2,"-")
C2 = GetCompanyName(D2,"-")

Trần Văn Bình · 22/5/24

cadafi đã viết:
Đối với bài toán của bạn, bạn có thể đặt hai Function như sau:

PHP:

Function GetCompanyCode(TgStr As String, TgChar As String) As String Dim iPosition As Integer: iPosition = InStr(TgStr, TgChar) If iPosition > 0 Then GetCompanyCode = Left(TgStr, iPosition) End Function

và

PHP:

Function GetCompanyName(TgStr As String, TgChar As String) As String Dim iPosition As Integer: iPosition = InStr(TgStr, TgChar) If iPosition > 0 Then GetCompanyName = Right(TgStr, Len(TgStr) - iPosition) End Function

Sau đó, có thể dùng tuỳ biến trên sheet, như data hiện có của bạn thì mình thấy ký tự ngăn cách là Char(10) (tương đương Alt+Enter), thì cú pháp là

PHP:

= GetCompanyCode(D2,Char(10)) = GetCompanyName(D2,Char(10))

Trong trường hợp data bạn dùng ký tự khác ngăn cách thì thay Char(10) bằng ký tự ngăn cách đó. Ví dụ:

PHP:

D2="3100771234-CÔNG TY TNHH DỊCH VỤ THƯƠNG MẠI ĐIỆN TỬ VATOTA" B2 = GetCompanyCode(D2,"-") C2 = GetCompanyName(D2,"-")

Cám ơn bạn nhiều mình dùng Function của bạn chạy chính xác theo mong muốn

Duy Tùng 9x · 22/5/24

Có thể dùng Textsplit, textbefore, hoặc filterxml,... cũng được mà

Mình thử text to colum cũng ổn, tách mã số thuế đó rồi tên đơn vị subtitute

VetMini · 22/5/24

Sử dụng hàm con thì phải biết viết code theo lối cấu trúc:
Đối với bài toán dùng hàm co code gần gión nhau, người ta có thể đặt hai Function con như sau:

Function GetCompanyCode(TgStr As String, TgChar As String) As String
GetCompanyCode = Trim(CompanyCodeandName(0))
End Function

Function GetCompanyName(TgStr As String, TgChar As String) As String
GetCompanyCode = Trim(CompanyCodeandName(1))
End Function

Function CompanyCodeandName(TgStr As String, TgChar As String) As Variant
CompanyCodeandName = Split(tgStr, TgChar)
End Function

Tách dữ liệu mã số đơn vị và tên đơn vị ra 02 cột bằng VBA

Trần Văn Bình

GTVT

File đính kèm

Phuocam

Thành viên mới

Trần Văn Bình

GTVT

CHAOQUAY

Thành viên gắn bó

Phuocam

Thành viên mới

Trần Văn Bình

GTVT

Phuocam

Thành viên mới

Trần Văn Bình

GTVT

Phuocam

Thành viên mới

Trần Văn Bình

GTVT

cadafi

Hành động từ trái tim

Trần Văn Bình

GTVT

Duy Tùng 9x

Thành viên chính thức

VetMini

Ăn cùng góc phố

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng