Xin giải pháp tách mã phiếu từ nội dung tổng hợp có nhiều thông tin

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

LanAnh139

Thành viên mới
Tham gia
4/3/24
Bài viết
9
Được thích
2
XIn chào các bác, em hơi kém môn excel nên muốn nhờ các cao nhân chỉ giáo giúp em để có thể giải được bài toán này ạ.
Em có các thông tin chuỗi như sau ạ. Mong nhờ các bác giúp em lọc được ra thông tin ở cột thứ 2 với ạ, em xin cảm ơn.
Nội dung giả địnhNội dung mong muốnghi chú
33B1 49B1 GD 985340-021824 09:35:13
33B1 và 49B1
NGUYEN VAN A CHUYEN TIEN 607MN4 FT14561235468796 GD 520920-021824 09:33:15
607MN4
MBVCB.1235415464.031619.30604MN2.CT TU 078451265 NGUYEN VAN A TOI 57145621 TRAN VAN B TAI BANK GD 123456-654321 09:30:21
30604MN2
THANH TOAN QR 22B8 GD 673230-234578 09:56:24
22B8
 
XIn chào các bác, em hơi kém môn excel nên muốn nhờ các cao nhân chỉ giáo giúp em để có thể giải được bài toán này ạ.
Em có các thông tin chuỗi như sau ạ. Mong nhờ các bác giúp em lọc được ra thông tin ở cột thứ 2 với ạ, em xin cảm ơn.
Nội dung giả địnhNội dung mong muốnghi chú
33B1 49B1 GD 985340-021824 09:35:13
33B1 và 49B1
NGUYEN VAN A CHUYEN TIEN 607MN4 FT14561235468796 GD 520920-021824 09:33:15
607MN4
MBVCB.1235415464.031619.30604MN2.CT TU 078451265 NGUYEN VAN A TOI 57145621 TRAN VAN B TAI BANK GD 123456-654321 09:30:21
30604MN2
THANH TOAN QR 22B8 GD 673230-234578 09:56:24
22B8
Vấn đề khá rối, gởi file với nhiều dạng ví dụ minh họa hơn, hy vọng VBA xử lý được
 
XIn chào các bác, em hơi kém môn excel nên muốn nhờ các cao nhân chỉ giáo giúp em để có thể giải được bài toán này ạ.
Em có các thông tin chuỗi như sau ạ. Mong nhờ các bác giúp em lọc được ra thông tin ở cột thứ 2 với ạ, em xin cảm ơn.
Nội dung giả địnhNội dung mong muốnghi chú
33B1 49B1 GD 985340-021824 09:35:13
33B1 và 49B1
NGUYEN VAN A CHUYEN TIEN 607MN4 FT14561235468796 GD 520920-021824 09:33:15
607MN4
MBVCB.1235415464.031619.30604MN2.CT TU 078451265 NGUYEN VAN A TOI 57145621 TRAN VAN B TAI BANK GD 123456-654321 09:30:21
30604MN2
THANH TOAN QR 22B8 GD 673230-234578 09:56:24
22B8
@LanAnh139
Không dám nhận là "cao nhân, thấp nhân,..." gì, nhưng mạo muội với bạn chủ thớt Tham khảo code cùi bắp sau:

Mã:
Option Explicit

Sub Tach()
Dim i&, j&, Lr&
Dim Arr(), KQ(), S, Temp As String
With Sheet1
Lr = .Cells(1000, 1).End(xlUp).Row
Arr = .Range("A4:A" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
    Temp = Application.Substitute(Arr(i, 1), "-", " ")
    Temp = Application.Substitute(Temp, ":", " ")
    Temp = Application.Substitute(Temp, ".", " ")
    S = Split(Temp, " ")
        For j = LBound(S) To UBound(S)
            If IsNumeric(S(j)) = False And IsNumeric(Left(S(j), 1)) And IsNumeric(Right(S(j), 1)) Then
                If KQ(i, 1) = Empty Then KQ(i, 1) = S(j) Else KQ(i, 1) = KQ(i, 1) & " và " & S(j)
            End If
        Next j
Next i
.Range("C4").Resize(i - 1, 1) = KQ
End With
End Sub
Code này có thể chỉ đúng với dữ liệu đã cho.
 
XIn chào các bác, em hơi kém môn excel nên muốn nhờ các cao nhân chỉ giáo giúp em để có thể giải được bài toán này ạ.
Em có các thông tin chuỗi như sau ạ. Mong nhờ các bác giúp em lọc được ra thông tin ở cột thứ 2 với ạ, em xin cảm ơn.
Nội dung giả địnhNội dung mong muốnghi chú
33B1 49B1 GD 985340-021824 09:35:13
33B1 và 49B1
NGUYEN VAN A CHUYEN TIEN 607MN4 FT14561235468796 GD 520920-021824 09:33:15
607MN4
MBVCB.1235415464.031619.30604MN2.CT TU 078451265 NGUYEN VAN A TOI 57145621 TRAN VAN B TAI BANK GD 123456-654321 09:30:21
30604MN2
THANH TOAN QR 22B8 GD 673230-234578 09:56:24
22B8

Mã:
Sub abc()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k

Nguon = Sheet1.Range("A2:A5")
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 1)

For i = 1 To rws
    k = IIf(InStr(Nguon(i, 1), "."), ".", " ")
    For Each j In Split(Nguon(i, 1), k)
        If IsNumeric(Left(j, 1)) Then
            If IsNumeric(Right(j, 1)) Then
                If IsNumeric(Mid(j, Len(j) - 1, 1)) = False Then
                    Kq(i, 1) = Kq(i, 1) & " " & j
                End If
            End If
        End If
    Next j
    Kq(i, 1) = Trim(Kq(i, 1))
Next i
Sheet1.Range("B2").Resize(rws, 1) = Kq
End Sub
 
. . . . Em có các thông tin chuỗi như sau ạ. Mong nhờ các bác giúp em lọc được ra thông tin như ở cột . . . .
Nội dung giả địnhNội dung mong muốnghi chú
33B1 49B1 GD 985340-021824 09:35:13
33B1 và 49B1
NGUYEN VAN A CHUYEN TIEN 607MN4 FT14561235468796 GD 520920-021824 09:33:15
607MN4
MBVCB.1235415464.031619.30604MN2.CT TU 078451265 NGUYEN VAN A TOI 57145621 TRAN VAN B TAI BANK GD 123456-654321 09:30:21
30604MN2
THANH TOAN QR 22B8 GD 673230-234578 09:56:24
22B8
(/ấn đề chắc đang là nhờ cộng đồng này dọn rác dùm từ phần mềm tạo rác nào đó?
$$$$@ :D :D :D
 
Em không biết coi là rác không, nhưng nội dung diễn giải trong sao kê ngân hàng nó tả phí lù như vậy đấy bác ạ :((
Vấn đề khá rối, gởi file với nhiều dạng ví dụ minh họa hơn, hy vọng VBA xử lý
Vấn đề khá rối, gởi file với nhiều dạng ví dụ minh họa hơn, hy vọng VBA xử lý được
đấy là ví dụ về nội dung sao kê ngân hàng bác ạ, nó khá là hỗn loạn, mỗi đầu ngân hàng chuyển nó sẽ có những hiển thị thay đổi 1 chút. Em mong muốn là tìm ra cách để lọc được nội dung mã hàng hóa, mã phiếu mà khách hàng nhập trong nội dung thanh toán kia ạ, làm được 80% thôi là em cũng đã mừng lắm chứ cũng không kỳ vọng có thể ra được 100%.
(/ấn đề chắc đang là nhờ cộng đồng này dọn rác dùm từ phần mềm tạo rác nào đó?
$$$$@ :D :D :D
 
Bác cho em hỏi, với code này, thì lúc nhập vào excel em nhập câu lệnh là gì ạ, bác thông cảm em kém món này quá nên hỏi có phần ngu ngơ
@LanAnh139
Không dám nhận là "cao nhân, thấp nhân,..." gì, nhưng mạo muội với bạn chủ thớt Tham khảo code cùi bắp sau:

Mã:
Option Explicit

Sub Tach()
Dim i&, j&, Lr&
Dim Arr(), KQ(), S, Temp As String
With Sheet1
Lr = .Cells(1000, 1).End(xlUp).Row
Arr = .Range("A4:A" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
    Temp = Application.Substitute(Arr(i, 1), "-", " ")
    Temp = Application.Substitute(Temp, ":", " ")
    Temp = Application.Substitute(Temp, ".", " ")
    S = Split(Temp, " ")
        For j = LBound(S) To UBound(S)
            If IsNumeric(S(j)) = False And IsNumeric(Left(S(j), 1)) And IsNumeric(Right(S(j), 1)) Then
                If KQ(i, 1) = Empty Then KQ(i, 1) = S(j) Else KQ(i, 1) = KQ(i, 1) & " và " & S(j)
            End If
        Next j
Next i
.Range("C4").Resize(i - 1, 1) = KQ
End With
End Sub
Code này có thể chỉ đúng với dữ liệu đã cho.
 
Bác cho em hỏi, với code này, thì lúc nhập vào excel em nhập câu lệnh là gì ạ, bác thông cảm em kém món này quá nên hỏi có phần ngu ngơ
Bạn có biết tại sao ít người hỗ trợ bạn không? Bởi vì bạn không đăng cái file giả định của bạn lên. Họ code cho bạn họ phải giả định dữ liệu. sau khi chạy thử xong thì họ xóa bỏ file luôn.

Còn muốn thì : Mở file có dữ liệu lên.=>nhấn Alt+F11 => hiện của sổ VBE ra => vào insert/chon module/ Paste code vào .
Ra ngoài màn hình (đang hiện thị bảng tính): Chon Insert / chọn IIIlustrations/Chọn Shapes/Vẽ 1 shape/Phải chuột vào Shapes vừa vẽ /chọn Assigns Macro/Chọn Vào Tên module vừa Paste/Chọn OK
Từ bây giờ click chuột vào Shapes là code chạy.

Chúc thành công.
 
Mã:
Sub abc()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k

Nguon = Sheet1.Range("A2:A5")
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 1)

For i = 1 To rws
    k = IIf(InStr(Nguon(i, 1), "."), ".", " ")
    For Each j In Split(Nguon(i, 1), k)
        If IsNumeric(Left(j, 1)) Then
            If IsNumeric(Right(j, 1)) Then
                If IsNumeric(Mid(j, Len(j) - 1, 1)) = False Then
                    Kq(i, 1) = Kq(i, 1) & " " & j
                End If
            End If
        End If
    Next j
    Kq(i, 1) = Trim(Kq(i, 1))
Next i
Sheet1.Range("B2").Resize(rws, 1) = Kq
End Sub
Em cảm ơn bác, em sẽ làm thử ạ.
Bài đã được tự động gộp:

Bạn có biết tại sao ít người hỗ trợ bạn không? Bởi vì bạn không đăng cái file giả định của bạn lên. Họ code cho bạn họ phải giả định dữ liệu. sau khi chạy thử xong thì họ xóa bỏ file luôn.

Còn muốn thì : Mở file có dữ liệu lên.=>nhấn Alt+F11 => hiện của sổ VBE ra => vào insert/chon module/ Paste code vào .
Ra ngoài màn hình (đang hiện thị bảng tính): Chon Insert / chọn IIIlustrations/Chọn Shapes/Vẽ 1 shape/Phải chuột vào Shapes vừa vẽ /chọn Assigns Macro/Chọn Vào Tên module vừa Paste/Chọn OK
Từ bây giờ click chuột vào Shapes là code chạy.

Chúc thành công.
mình cảm ơn bạn đã đóng góp ý kiến, mình sẽ lưu ý, mong được mọi người chỉ giáo nhiều nhiều
 
(/ấn đề chắc đang là nhờ cộng đồng này dọn rác dùm từ phần mềm tạo rác nào đó?
Bình thường chứ gì. Có được bao nhiêu phần trăm chuyện trích chuỗi đưa lên đây mà chẳng phải từ chuỗi rác?
Có lúc vừa đưa rác vừa chưởi mà cũng đâm đầu vào.
(nhớ cách đây mấy năm có kẻ thẳng thừng nói "diễn đàn cũng như công viên, chỉ ghé vào khi cần giải quyết...")

Mã:
Function TachMa(s As String)
' hàm đọc chuỗi s, lọc lấy ra những chuỗi con ở dạng 9999MN9, hoặc 999B9
' trả về mảng chuỗi đã lọc được.
With CreateObject("vbscript.regexp")
  .Global = True
  .MultiLine = MultiLine
  .IgnoreCase = IgnoreCase
  .Pattern = "\d+(B|MN)\d"
  Set matches = .Execute(s)
End With
If matches.Count > 0 Then
  ReDim a(1 To matches.Count)
  For Each mtch In matches
    i = i + 1
    a(i) = mtch
  Next mtch
  TachMa = a
End If
End Function
 
Bình thường chứ gì. Có được bao nhiêu phần trăm chuyện trích chuỗi đưa lên đây mà chẳng phải từ chuỗi rác?
Có lúc vừa đưa rác vừa chưởi mà cũng đâm đầu vào.
(nhớ cách đây mấy năm có kẻ thẳng thừng nói "diễn đàn cũng như công viên, chỉ ghé vào khi cần giải quyết...")

Mã:
Function TachMa(s As String)
' hàm đọc chuỗi s, lọc lấy ra những chuỗi con ở dạng 9999MN9, hoặc 999B9
' trả về mảng chuỗi đã lọc được.
With CreateObject("vbscript.regexp")
  .Global = True
  .MultiLine = MultiLine
  .IgnoreCase = IgnoreCase
  .Pattern = "\d+(B|MN)\d"
  Set matches = .Execute(s)
End With
If matches.Count > 0 Then
  ReDim a(1 To matches.Count)
  For Each mtch In matches
    i = i + 1
    a(i) = mtch
  Next mtch
  TachMa = a
End If
End Function
cảm ơn bác rất nhiều ạ, với function này em làm ra kết quả được 80% rồi bác ạ, nếu em thêm dạng mẫu chuỗi con vào thì kết quả sẽ mở rộng hơn phải không bác?
 
Xem thử hàm này lấy được bao nhiêu %, sử dụng excel365
1/Tách chuỗi theo các ký tự {"."," ","-"}
2/Trong chuỗi gồm có số (đầu và cuối) và các chữ cái (A,B,C...) có trong chuỗi
Mã:
=MAP(B4:B7,LAMBDA(m,LET(t,TEXTSPLIT(m,,{"."," ","-"}),ARRAYTOTEXT(FILTER(t,MAP(t,LAMBDA(x,LET(md,MID(x,SEQUENCE(LEN(x)),1),AND(ISNUMBER(--LEFT(x,1)),ISNUMBER(--RIGHT(x,1)),AND(IFERROR(BYROW(N(FILTER(md,ISERR(--md))=CHAR(SEQUENCE(,26,65))),SUM),)))))))))))
1709780087279.png
 
Vậy mấy code ở trển thì bao nhiêu % nhẩy?
Và 20% còn lại thế nào?
Bạn hãy đưa thêm dạng để trăm phần trăm. --=0 --=0 --=0
mấy code trên em test đang bị lỗi với file gốc của em bác ạ, có thể là do em làm chưa đúng cách :(.
Function trên em lọc được các mã có dạng 12345MN1, 123B1 rồi, em còn mã phiếu em dạng 12345PT12, 12345CC12, 123C12, 12345BAC nữa bác ạ. Trước mắt như thế này em thấy mừng rơi nước mắt rồi ạ, em làm bằng hàm mid thì ra được 60%, mà vẫn phải thủ công một vài chỗ, cảm ơn các bác nhiều lắm ạ.
 
12345PT12, 12345CC12, 123C12, 12345BAC
Nếu thế này thì tớ đề nghị thế này, hy vọng tự sửa được:
Mã:
Function TachMa(s As String, pat$)

...

  .Pattern = pat '"\d+(B|MN)\d"
 
...
Hàm: =TachMa(ô chứa;"\b\d{1,5}[A-Z]{1,3}(\d+|\b)")

Nếu chưa đạt trăm / trăm thì nông dân tay làm hàm nhai là thượng sách, dữ liệu quá đa năng, làm ăn quá rộng, chuyển khoản đủ kiểu.
 
Có thể cần một function en-Regex Pattern.
Bạn đưa TẤT CẢ các mẫu lên (nằm trong một WorkSheet nào đó). Nếu rảnh tôi sẽ viết cài hàm encode này.
 
mấy code trên em test đang bị lỗi với file gốc của em bác ạ, có thể là do em làm chưa đúng cách :(.
Function trên em lọc được các mã có dạng 12345MN1, 123B1 rồi, em còn mã phiếu em dạng 12345PT12, 12345CC12, 123C12, 12345BAC nữa bác ạ. Trước mắt như thế này em thấy mừng rơi nước mắt rồi ạ, em làm bằng hàm mid thì ra được 60%, mà vẫn phải thủ công một vài chỗ, cảm ơn các bác nhiều lắm ạ.
Kể ra dữ liệu mà nhiều(100000 data) với lại nhiều kiểu ấy và không có quy luật thì cũng mệt.
Góp vui bằng 1 hàm UDF:
Mã:
Function Tach(ByVal Arr As Range) As String
Dim i&, j&, Lr&
Dim KQ(), S, Temp As String
With Sheet1
    Temp = Replace(Replace(Replace(Arr, "-", " "), ":", " "), ".", " ")
    S = Split(Temp, " ")
        For j = LBound(S) To UBound(S)
            If IsNumeric(S(j)) = False And IsNumeric(Left(S(j), 1)) And IsNumeric(Right(S(j), 1)) Then
                If Tach = Empty Then Tach = S(j) Else Tach = Tach & " và " & S(j)
            End If
        Next j

End With
End Function
 
Kể ra dữ liệu mà nhiều(100000 data) với lại nhiều kiểu ấy và không có quy luật thì cũng mệt.
Góp vui bằng 1 hàm UDF:
Mã:
Function Tach(ByVal Arr As Range) As String
Dim i&, j&, Lr&
Dim KQ(), S, Temp As String
With Sheet1
    Temp = Replace(Replace(Replace(Arr, "-", " "), ":", " "), ".", " ")
    S = Split(Temp, " ")
        For j = LBound(S) To UBound(S)
            If IsNumeric(S(j)) = False And IsNumeric(Left(S(j), 1)) And IsNumeric(Right(S(j), 1)) Then
                If Tach = Empty Then Tach = S(j) Else Tach = Tach & " và " & S(j)
            End If
        Next j

End With
End Function
cảm ơn bác, em đã test thử kết quả ra tương đối bác ạ, nó vẫn bị lỗi ở một số dòng nó lọc cả thông tin mà không phải mã cần lọc nữa bác ạ.
Bài đã được tự động gộp:

Nếu thế này thì tớ đề nghị thế này, hy vọng tự sửa được:
Mã:
Function TachMa(s As String, pat$)

...

  .Pattern = pat '"\d+(B|MN)\d"
 
...
Hàm: =TachMa(ô chứa;"\b\d{1,5}[A-Z]{1,3}(\d+|\b)")

Nếu chưa đạt trăm / trăm thì nông dân tay làm hàm nhai là thượng sách, dữ liệu quá đa năng, làm ăn quá rộng, chuyển khoản đủ kiểu.
sửa ntn nó lại ra ít kết quả hơn hàm cũ bác ạ.
 
Lần chỉnh sửa cuối:
cảm ơn bác, em đã test thử kết quả ra tương đối bác ạ, nó vẫn bị lỗi ở một số dòng nó lọc cả thông tin mà không phải mã cần lọc nữa bác ạ.
Bài đã được tự động gộp:


sửa ntn nó lại ra ít kết quả hơn hàm cũ bác ạ.
Chỉ có việc copy cái cột chứa dữ liệu vào 1 sheet rồi gởi lên mà không làm được thì còn làm được gì tốt hơn? Nhìn lướt qua thì cũng không đến nổi quá khó. Tuy nhiên không biết ông bà nào đã tạo ra 1 loại dữ liệu nguồn đáng kính nể. Bái phục thiệt đó.
 
Web KT
Back
Top Bottom