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

[Trần Văn Bình]

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]

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]

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]

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

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]

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]

Chạy thử xem sao

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]

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]

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]

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:

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]

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

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]

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

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à

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à

= 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ụ:

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]

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

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à

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à

= 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ụ:

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]

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]

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