Xử lý Chuỗi, tách số ra khỏi chuỗi

Liên hệ QC
TuanPV2803

TuanPV2803

Thành viên mới
Tham gia
27/7/18
Bài viết
13
Được thích
2
Dear các anh chị!
Em có một bảng tính gồm rất nhiều mã hàng như sau:
CP950x2150mt
cox1230x900
Ctp560x1830tl
.....
Em muốn viết code tách riêng các chuỗi số ra 2 cột khác nhau ví dụ:


CP950x2150mt

950

2150

Nhưng thật sự em đã tìm kiếm rất nhiều và chỉ thấy tách ra thành 9502150
Vậy rất mong các anh chị em trong diễn đàn giúp đỡ em với!
Em xin chân thành cảm ơn!
Em gửi file đính kèm mong các anh chị em giúp em với ạ!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
TuanPV2803 đã viết:
Dear các anh chị!
Em có một bảng tính gồm rất nhiều mã hàng như sau:
CP950x2150mt
cox1230x900
Ctp560x1830tl
.....
Em muốn viết code tách riêng các chuỗi số ra 2 cột khác nhau ví dụ:

CP950x2150mt

950

2150

Nhưng thật sự em đã tìm kiếm rất nhiều và chỉ thấy tách ra thành 9502150
Vậy rất mong các anh chị em trong diễn đàn giúp đỡ em với!
Em xin chân thành cảm ơn!
Em gửi file đính kèm mong các anh chị em giúp em với ạ!
Nhấp chuột vào đây để mở rộng...
Góp vui thêm công thức:
Mã: 
C11=LOOKUP(10^9,--MID(B11,LOOKUP(10^9,SEARCH(TEXT(ROW($1:$99),"0x0"),B11))-ROW($1:$9)+1,ROW($1:$9)))
D11=LOOKUP(10^9,--MID(B11,LOOKUP(10^9,SEARCH(TEXT(ROW($1:$99),"0x0"),B11))+2,ROW($1:$9)))
 
Upvote 0
TuanPV2803 đã viết:
Dear các anh chị!
Em có một bảng tính gồm rất nhiều mã hàng như sau:
CP950x2150mt
cox1230x900
Ctp560x1830tl
.....
Em muốn viết code tách riêng các chuỗi số ra 2 cột khác nhau ví dụ:

CP950x2150mt

950

2150

Nhưng thật sự em đã tìm kiếm rất nhiều và chỉ thấy tách ra thành 9502150
Vậy rất mong các anh chị em trong diễn đàn giúp đỡ em với!
Em xin chân thành cảm ơn!
Em gửi file đính kèm mong các anh chị em giúp em với ạ!
Nhấp chuột vào đây để mở rộng...
Góp thêm tí gió cho thuyền ra khơi.
Mã: 
Option Explicit

Sub TachSo()
Dim SArr, Res
Dim i
SArr = Sheet1.Range("b11", Sheet1.Range("b65000").End(xlUp))
ReDim Res(1 To UBound(SArr), 1 To 2)
With CreateObject("VbScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "\D+(\d+)[x](\d+).*"
    For i = 1 To UBound(SArr)
        If .test(SArr(i, 1)) Then
            Res(i, 1) = .Replace(SArr(i, 1), "$1")
            Res(i, 2) = .Replace(SArr(i, 1), "$2")
        End If
    Next i
End With
With Sheet1
.Range("c11", "d" & UBound(Res) + 10).ClearContents
.Range("c11", "d" & UBound(Res) + 10) = Res
End With
End Sub
 
Upvote 0
CHAOQUAY đã viết:
Góp thêm tí gió cho thuyền ra khơi.
Mã: 
Option Explicit

Sub TachSo()
Dim SArr, Res
Dim i
SArr = Sheet1.Range("b11", Sheet1.Range("b65000").End(xlUp))
ReDim Res(1 To UBound(SArr), 1 To 2)
With CreateObject("VbScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "\D+(\d+)[x](\d+).*"
    For i = 1 To UBound(SArr)
        If .test(SArr(i, 1)) Then
            Res(i, 1) = .Replace(SArr(i, 1), "$1")
            Res(i, 2) = .Replace(SArr(i, 1), "$2")
        End If
    Next i
End With
With Sheet1
.Range("c11", "d" & UBound(Res) + 10).ClearContents
.Range("c11", "d" & UBound(Res) + 10) = Res
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Gió của bạn hơi nhiều quá. Có lẽ bạn quen theo các vị kỳ cựu ở diễn đàn này và thích dùng hàm Replace.
Nếu bạn dùng hàm Execute thì chỉ phải gọi 1 lần, và lấy mấy cái Submatches của nó.

[x] tức là x. Dấu ngoặc vuông dùng để làm một danh sách các ký tự cần match. Ở đây bạn chỉ có 1.
Đồng thời cũng nên lưu ý là cái mẫu của bạn thuộc dạng "tham lam", chạy tốn năng lượng.

Nên tập quen cách lấy submatches và diễn mẫu pattern.
 
Upvote 0
Kiểm thấy Code của Anh @HieuCD bị một lỗi, Nếu thừa ký tự phân biệt là "x"
Phương thức Split sẽ bị vô hiệu hóa tác dụng . Ví dụ chuỗi là "xxxx123x456xxxx"
Vì thế nếu chuỗi không theo nguyên tắc thì code vẫn sẽ gặp lỗi

Và thấy mọi người viết Hàm với VBA cũng vui vui vậy nên tham gia một Hàm

Diễn Giải:
Duyệt chuỗi "xxxx123x456xxxx"
Nếu tìm thấy "x" thì tìm ngược về trước để lấy số đứng trước
Nếu tồn tại số đứng trước thì Tiếp tục duyệt tìm số đứng sau
Nếu tìm thấy "x" mà không tìm được số đứng trước và số đứng sau thì tiếp tục tìm kiếm cho đến khi kết thúc

Sử dụng:
NumberBefore = ReNumber("xxxx123x456xxxx")
NumberAfter = ReNumber("xxxx123x456xxxx", 1)

Mọi người thử code dưới và thêm góp ý chỉnh sửa sai sót
PHP: 
Function ReNumber&(str$, Optional idx& = 0)
  Dim i&, j&, k&, strB$, strA$, strMid$
  For i = 1 To Len(str)
    If strB <> "" Then
      strMid = Mid$(str, k + 1, i - k)
      If Not IsNumeric(strMid) Then Exit For
      strA = strMid
    End If
    If LCase$(Mid$(str, i, 1)) = "x" And LCase$(Mid$(str, i + 1, 1)) <> "x" Then
      k = i
      For j = 1 To k - 1
        strMid = Mid$(str, j, k - j)
        If IsNumeric(strMid) Then strB = strMid: Exit For
      Next j
    End If
  Next
  If strA <> "" Then ReNumber = IIf(idx = 0, strB, strA)
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
HeSanbi đã viết:
Kiểm thấy Code của Anh @HieuCD bị một lỗi, Nếu thừa ký tự phân biệt là "x"
Phương thức Split sẽ bị vô hiệu hóa tác dụng . Ví dụ chuỗi là "xxxx123x456xxxx"
Vì thế nếu chuỗi không theo nguyên tắc thì code vẫn sẽ gặp lỗi

Và thấy mọi người viết Hàm với VBA cũng vui vui vậy nên tham gia một Hàm

Diễn Giải:
Duyệt chuỗi "xxxx123x456xxxx"
Nếu tìm thấy "x" thì tìm ngược về trước để lấy số đứng trước
Nếu tồn tại số đứng trước thì Tiếp tục duyệt tìm số đứng sau
Nếu tìm thấy "x" mà không tìm được số đứng trước và số đứng sau thì tiếp tục tìm kiếm cho đến khi kết thúc

Sử dụng:
NumberBefore = ReNumber("xxxx123x456xxxx")
NumberAfter = ReNumber("xxxx123x456xxxx", 1)

Mọi người thử code dưới và thêm góp ý chỉnh sửa sai sót
PHP: 
Function ReNumber&(str$, Optional idx& = 0)
  Dim i&, j&, k&, strB$, strA$, strMid$
  For i = 1 To Len(str)
    If strB <> "" Then
      strMid = Mid$(str, k + 1, i - k)
      If Not IsNumeric(strMid) Then Exit For
      strA = strMid
    End If
    If LCase$(Mid(str, i, 1)) = "x" Then
      k = i
      For j = 1 To k - 1
        strMid = Mid$(str, j, k - j)
        If IsNumeric(strMid) Then strB = strMid: Exit For
      Next j
    End If
  Next
  If strB <> "" Then ReNumber = IIf(idx = 0, strB, strA)
End Function
Nhấp chuột vào đây để mở rộng...
Viết code nên căn cứ vào tình huống thực tế đưa ra giải pháp phù hợp, Không nên thay đổi đặc điểm của dữ liệu
Theo code trên, trong dữ liệu có trường hợp 3 nhóm số "xx1xxx234x456xxx" thì xử lý như thế nào? Nếu chỉ có 2 nhóm số cần chi tới 2 vòng lặp ?
 
Upvote 0
Giải thuật mò ký tự thì hiệu quả của nó dựa vào dạng phức tạp của chuỗi đầu vào.
Nếu chuỗi dài thòng lòng và số/kết quả thường nằm ở gần đầu thì duyệt từng ký tự - duyệt lấy được kết quả rồi thì ngưng.
Nếu chuỗi đơn giản (như đề bài) thì dùng hàm tìm ký tự (InStr) rồi lấy trái và phải - dùng hàm Split thì chỉ là một hình thức khác của phương pháp tìm ký tự. Nếu ký tự có thể xuất hiện nhiều lần thì giải thuật chỉ cần thêm phần xét số.

HieuCD đã viết:
Viết code nên căn cứ vào tình huống thực tế đưa ra giải pháp phù hợp, Không nên thay đổi đặc điểm của dữ liệu
Theo code trên, trong dữ liệu có trường hợp 3 nhóm số "xx1xxx234x456xxx" thì xử lý như thế nào? Nếu chỉ có 2 nhóm số cần chi tới 2 vòng lặp ?
Nhấp chuột vào đây để mở rộng...
Bao nhiêu vòng lặp cũng không thành vấn đề. Bởi vì code ấy nó đã rắc rối từ căn bản. Và rắc rối mà chưa chắc đã đúng.
Nếu chuỗi là abc123xyz456abc thì nó vẫn lấy ra 123. Đơn giản vậy thôi.
 
Upvote 0
HieuCD đã viết:
Viết code nên căn cứ vào tình huống thực tế đưa ra giải pháp phù hợp, Không nên thay đổi đặc điểm của dữ liệu
Theo code trên, trong dữ liệu có trường hợp 3 nhóm số "xx1xxx234x456xxx" thì xử lý như thế nào? Nếu chỉ có 2 nhóm số cần chi tới 2 vòng lặp ?
Nhấp chuột vào đây để mở rộng...
Ý trên của em đã nói rõ "Nếu thừa ký tự phân biệt là x - 'DP100x400xL', 'DP100x400Lx'"
Còn ví dụ chỉ là để Kiểm tra thử thôi.
Vấn đề vòng lặp cũng không ảnh hưởng lớn đến tốc độ với chuỗi dạng này.

Cảm ơn Anh đã góp ý , thêm một điều kiện ràng buộc nếu dữ liệu như Anh gợi ý:
PHP: 
If LCase$(Mid(str, i, 1)) = "x" And LCase$(Mid(str, i + 1, 1)) <> "x" Then
VetMini đã viết:
Nếu chuỗi là abc123xyz456abc thì nó vẫn lấy ra 123
Nhấp chuột vào đây để mở rộng...
Lúc đầu em để code: StrA là chuỗi Số đứng trước, StrB là chuỗi số đứng sau.
Khi định nghĩa trong suy nghĩ hiểu StrB, StrA là String Before và String After
Nhìn lại code biết mình đã nhầm. Khi sửa ngược lại đã bị thiếu sót khâu trả kết quả
Mã: 
StrB = "" đã sửa lại StrA = ""
 
Lần chỉnh sửa cuối:
Upvote 0
Em mới tập viết mãi mới được cái này. Mong mọi người chỉ bảo thêm ạ
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Long
    Dim I As Long, strTemp As String
For I = 1 To Len(txt)
    Select Case Asc(Mid(txt, I, 1))
        Case 40 To 57, 94
            strTemp = strTemp & Mid(txt, I, 1)
        Case Else
            strTemp = strTemp & " "
    End Select
Next I
If Len(strTemp) Then strTemp = Application.Trim(strTemp)
If Len(strTemp) Then ExtractNumber = Split(strTemp, " ")(N - 1)
End Function
 

File đính kèm

Upvote 0
Nhất Chi Lan đã viết:
Em mới tập viết mãi mới được cái này. Mong mọi người chỉ bảo thêm ạ
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Long
    Dim I As Long, strTemp As String
For I = 1 To Len(txt)
    Select Case Asc(Mid(txt, I, 1))
        Case 40 To 57, 94
            strTemp = strTemp & Mid(txt, I, 1)
        Case Else
            strTemp = strTemp & " "
    End Select
Next I
If Len(strTemp) Then strTemp = Application.Trim(strTemp)
If Len(strTemp) Then ExtractNumber = Split(strTemp, " ")(N - 1)
End Function
Nhấp chuột vào đây để mở rộng...
Không cần phải duyệt hết chuỗi. Sử dụng 1 biến đếm để đếm số chuỗi số liên tục và chỉ duyệt đến hết chuỗi số cần lấy.
 
Upvote 0
huuthang_bd đã viết:
Không cần phải duyệt hết chuỗi. Sử dụng 1 biến đếm để đếm số chuỗi số liên tục và chỉ duyệt đến hết chuỗi số cần lấy.
Nhấp chuột vào đây để mở rộng...
Dạ. Cám ơn Anh rất nhiều. Em sửa lại như thế này có được không ạ
PHP: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Double
    Dim I As Long, strTemp As String, atmp, Str As String
txt = Replace(txt, ",", ".")
For I = 1 To Len(txt)
    Select Case Asc(Mid(txt, I, 1))
        Case 40 To 57, 94
            strTemp = strTemp & Mid(txt, I, 1)
        Case Else
            strTemp = strTemp & " "
    End Select
    Str = Application.Trim(strTemp)
    atmp = Split(Str, " ")
    If UBound(atmp) > N - 1 Then Exit For
Next I
If Len(Str) Then ExtractNumber = Val(Split(Str, " ")(N - 1))
End Function
 
Upvote 0
Nhất Chi Lan đã viết:
Dạ. Cám ơn Anh rất nhiều. Em sửa lại như thế này có được không ạ
PHP: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Double
    Dim I As Long, strTemp As String, atmp, Str As String
txt = Replace(txt, ",", ".")
For I = 1 To Len(txt)
    Select Case Asc(Mid(txt, I, 1))
        Case 40 To 57, 94
            strTemp = strTemp & Mid(txt, I, 1)
        Case Else
            strTemp = strTemp & " "
    End Select
    Str = Application.Trim(strTemp)
    atmp = Split(Str, " ")
    If UBound(atmp) > N - 1 Then Exit For
Next I
If Len(Str) Then ExtractNumber = Val(Split(Str, " ")(N - 1))
End Function
Nhấp chuột vào đây để mở rộng...
Đây là 1 cách, bạn tham khảo.
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Long
Dim i As Long, Str As String
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then
        Str = Str & Mid(txt, i, 1)
    ElseIf Len(Str) Then
        If N = 1 Then Exit For
        N = N - 1:  Str = ""
    End If
Next
If N = 1 Then ExtractNumber = VBA.CLng(0 & Str)
End Function
 
Upvote 0
huuthang_bd đã viết:
Đây là 1 cách, bạn tham khảo.
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long) As Long
Dim i As Long, Str As String
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then
        Str = Str & Mid(txt, i, 1)
    ElseIf Len(Str) Then
        If N = 1 Then Exit For
        N = N - 1:  Str = ""
    End If
Next
If N = 1 Then ExtractNumber = VBA.CLng(0 & Str)
End Function
Nhấp chuột vào đây để mở rộng...
Cái Code này nó coi dấu "." hoặc dấu "," là kiểu chuỗi ạ
Ví dụ chuỗi tại ô A1 là: AA123.35bbb235
+ ExtractNumber(A1,1) =123
+ ExtractNumber(A1,2)=35
+ ExtractNumber(A1,3)=235
 
Upvote 0
PacificPR đã viết:
Cái Code này nó coi dấu "." hoặc dấu "," là kiểu chuỗi ạ
Ví dụ chuỗi tại ô A1 là: AA123.35bbb235
+ ExtractNumber(A1,1) =123
+ ExtractNumber(A1,2)=35
+ ExtractNumber(A1,3)=235
Nhấp chuột vào đây để mở rộng...
Tôi làm theo dữ liệu bài 1 mà. Nếu muốn số thập phân thì sửa lại như sau:
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long, DecimalSep As String) As Double
Dim i As Long, Str As String
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then
        Str = Str & Mid(txt, i, 1)
    ElseIf Mid(txt, i, 1) = DecimalSep Then
        If Len(Str) Then Str = Str & Mid(txt, i, 1)
    ElseIf Len(Str) Then
        If N = 1 Then Exit For
        N = N - 1:  Str = ""
    End If
Next
If N = 1 Then ExtractNumber = CDbl(Replace(0 & Str, DecimalSep, "."))
End Function
Mã: 
=ExtractNumber(A1,1,".")
 
Upvote 0
huuthang_bd đã viết:
Tôi làm theo dữ liệu bài 1 mà. Nếu muốn số thập phân thì sửa lại như sau:
Mã: 
Function ExtractNumber(ByVal txt As String, ByVal N As Long, DecimalSep As String) As Double
Dim i As Long, Str As String
For i = 1 To Len(txt)
    If IsNumeric(Mid(txt, i, 1)) Then
        Str = Str & Mid(txt, i, 1)
    ElseIf Mid(txt, i, 1) = DecimalSep Then
        If Len(Str) Then Str = Str & Mid(txt, i, 1)
    ElseIf Len(Str) Then
        If N = 1 Then Exit For
        N = N - 1:  Str = ""
    End If
Next
If N = 1 Then ExtractNumber = CDbl(Replace(0 & Str, DecimalSep, "."))
End Function
Mã: 
=ExtractNumber(A1,1,".")
Nhấp chuột vào đây để mở rộng...
Hay là mình tìm cái dấu thập phân bằng lệnh này ạ: Application.DecimalSeparator
 
Upvote 0
Em là thành viên mới tham gia và thấy VBA thật quan trọng và tuyệt vời và đang muốn học để mở rộng kiến thức! mong các anh chị chỉ bảo địa điểm có thể dăng ký học từ cơ bản được không ạ. em ở gò vấp có địa điểm nào gần đây dạy ngoài giờ không các anh chị!
 
Upvote 0
PacificPR đã viết:
Hay là mình tìm cái dấu thập phân bằng lệnh này ạ: Application.DecimalSeparator
Nhấp chuột vào đây để mở rộng...
Giả sử bạn đưa code đó vào file, dùng công thức trên sheet sau đó chuyển file cho người khác họ mở trên máy có thiết lập khác thì điều gì sẽ xảy ra?
 
Upvote 0
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
1
Đọc
15
thuytrangbp28
T
Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
15
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
40
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
217
HeSanbi
HeSanbi
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
3
Đọc
39
VetMini
V
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
52
VetMini
V
Y
Không copy được dữ liệu sang sheet khac
Trả lời
12
Đọc
24K
leduchien1001
L
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
10
Đọc
4K
dhtq159
D
N
Vẽ đường tròn bám theo 1 Polyline
Trả lời
4
Đọc
58
nguyenvanvien
N
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
3
Đọc
138
trung_bhxh
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
311
Đọc
23K
kunkoi9390
K
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
    • Yêu thích
Trả lời
4
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
OverAC
TPHCM - Gặp mặt đầu năm Ất Tỵ 18g ngày 8/2
    • Thích
    • Ngạc nhiên
Trả lời
1
Đọc
88
tungnguyen_kt
tungnguyen_kt
ptm0412
  • Question Question
Cách lấy link file excel nguồn cho Power query từ Onedrive, Google drive
    • Thích
    • Yêu thích
Trả lời
7
Đọc
3K
pxhieu1993
P
Y
Nhờ các anh chị xem giúp Hàm Sumproduct
Trả lời
0
Đọc
34
yoomi
Y
dinhnhat91
  • Question Question
VBA Lỗi runtime error 9 subscript out of range
Trả lời
4
Đọc
107
ongke0711
ongke0711
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
1
Đọc
564
PhanTuHuong
PhanTuHuong
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
0
Đọc
65
Việt Nguyễn 86
Việt Nguyễn 86
K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
62
khanhvinhdai1
K
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom