Xử lý Chuỗi, tách số ra khỏi chuỗi (1 người xem)

TuanPV2803 · 25/12/18

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 ạ!

Ba Tê · 25/12/18

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 ạ!

Chuyện này "hình như" dùng VBA cũng có khả năng giải quyết.
Nhưng "Sử lý" và "Dear" dò tự điển chưa ra nên khó mà xem tiếp.

saobekhonglac · 25/12/18

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 ạ!

Nếu dòng nào cũng có chữ "x" thì trong thời gian chờ đợi nên tách ra 2 cột (trước chữ x và sau chữ x). Sau đó dùng vba tách số và chữ ra là xong. Còn không thì chờ Anh/Em khác giúp cho code tách luôn.

TuanPV2803 · 25/12/18

Ba Tê đã viết:
Chuyện này "hình như" dùng VBA cũng có khả năng giải quyết.
Nhưng "Sử lý" và "Dear" dò tự điển chưa ra nên khó mà xem tiếp.

Dạ em cảm ơn sự chỉ bảo của anh về chính tả! lần sau em sẽ chú ý nhiều hơn ạ!

Bài đã được tự động gộp: 25/12/18

saobekhonglac đã viết:
Nếu dòng nào cũng có chữ "x" thì trong thời gian chờ đợi nên tách ra 2 cột (trước chữ x và sau chữ x). Sau đó dùng vba tách số và chữ ra là xong. Còn không thì chờ Anh/Em khác giúp cho code tách luôn.

Em cảm ơn anh nhiều cách của anh cũng rất hay để em làm trước theo cách này, có gì nhờ các anh em trong diễn đàn giúp viết giùm code tách luôn không cần bước tách nhỏ ra 2 cột ạ. thật sự em rất muốn học để làm như vậy!

gttrongvn · 25/12/18

Từ khóa cho bạn nè "CtoNPlus", bạn search trên GPE sẽ ra.

Ba Tê · 25/12/18

saobekhonglac đã viết:
Nếu dòng nào cũng có chữ "x" thì trong thời gian chờ đợi nên tách ra 2 cột (trước chữ x và sau chữ x). Sau đó dùng vba tách số và chữ ra là xong. Còn không thì chờ Anh/Em khác giúp cho code tách luôn.

Hổng ăn nỗi với dữ liệu chẳng có quy luật nào:
Bx1000x450RF -------->dòng 11
B250x324-S1 ---------->dòng 69
........................................

HeSanbi · 25/12/18

TuanPV2803 đã viết:
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

Chào bạn, bạn có thể xem qua code của tôi
Bạn có thể copy code sau vào Code của Worksheet chứa dữ liệu của bạn.
Giải thích một tí:
Code này sử dụng Regular expression
Nếu bạn Chọn một Cells mà có chứa dữ liệu mẫu thì nó sẽ cho kết quả ra đằng sau
Kể cả một mảng duyệt theo cột

Để giới hạng vùng chọn để Code thực hiện:

PHP:

If Intersect(Target, Range("A:A, D:D")) Is Nothing Then Exit Sub

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo EndS
  Dim ref As Object, isRefs As Boolean
  For Each ref In Application.VBE.ActiveVBProject.References
    If ref.Name = "VBScript_RegExp_55" Then isRefs = True
  Next ref
  If Not isRefs Then _
    ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\vbscript.dll\3"
  Dim iRegex As New VBScript_RegExp_55.RegExp
  Dim isArr As Boolean
  If IsArray(Selection.Value) Then
    If UBound(Selection.Value, 2) = 1 Then
      isArr = True
      Dim Arr: Arr = Selection.Value
      Dim aRow&: aRow = Selection.Row
      Dim aCol&: aCol = Selection.Column
    Else
      Exit Sub
    End If
  Else
    isArr = False
    Dim Text$: Text = Selection.Value
    If Text = "" Then Exit Sub
  End If

  With iRegex
    .Global = True
    .Pattern = "\d+[xX]\d+"
      If isArr Then
        Dim i
        For i = LBound(Arr) To UBound(Arr)
          If Arr(i, 1) <> "" And .Test(Arr(i, 1)) Then
            Arr(i, 1) = Replace(Arr(i, 1), "X", "x")
            Cells(aRow + i - 1, aCol + 1).Value = Split(.Execute(Arr(i, 1))(0), "x")(0)
            Cells(aRow + i - 1, aCol + 2).Value = Split(.Execute(Arr(i, 1))(0), "x")(1)
          End If
        Next i
      Else
        If .Test(Text) Then
          Selection(1, 2) = Split(.Execute(Text)(0), "x")(0)
          Selection(1, 3) = Split(.Execute(Text)(0), "x")(1)
        End If
      End If

  End With
EndS:
End Sub

chiendich · 25/12/18

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 ạ!

Dùng hàm nhé!

TuanPV2803 · 25/12/18

HeSanbi đã viết:

Chào bạn, bạn có thể xem qua code của tôi
Bạn có thể copy code sau vào Code của Worksheet chứa dữ liệu của bạn.
Giải thích một tí:
Code này sử dụng Regular expression
Nếu bạn Chọn một Cells mà có chứa dữ liệu mẫu thì nó sẽ cho kết quả ra đằng sau
Kể cả một mảng duyệt theo cột

Để giới hạng vùng chọn:

PHP:

If Intersect(Target, Range("A:A, D:D")) Is Nothing Then Exit Sub

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error GoTo EndS
  Dim ref As Object, isRefs As Boolean
  For Each ref In Application.VBE.ActiveVBProject.References
    If ref.Name = "VBScript_RegExp_55" Then isRefs = True
  Next ref
  If Not isRefs Then _
    ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\vbscript.dll\3"
  Dim iRegex As New VBScript_RegExp_55.RegExp
  Dim isArr As Boolean
  If IsArray(Selection.Value) Then
    If UBound(Selection.Value, 2) = 1 Then
      isArr = True
      Dim Arr: Arr = Selection.Value
      Dim aRow&: aRow = Selection.Row
      Dim aCol&: aCol = Selection.Column
    End If
  Else
    isArr = False
    Dim Text$: Text = Selection.Value
    If Text = "" Then Exit Sub
  End If

  With iRegex
    .Global = True
    .Pattern = "\d+[xX]\d+"
      If isArr Then
        Dim i
        For i = LBound(Arr) To UBound(Arr)
          If Arr(i, 1) <> "" And .Test(Arr(i, 1)) Then
            Arr(i, 1) = Replace(Arr(i, 1), "X", "x")
            Cells(aRow + i - 1, aCol + 1).Value = Split(.Execute(Arr(i, 1))(0), "x")(0)
            Cells(aRow + i - 1, aCol + 2).Value = Split(.Execute(Arr(i, 1))(0), "x")(1)
          End If
        Next i
      Else
        If .Test(Text) Then
          Selection(1, 2) = Split(.Execute(Text)(0), "x")(0)
          Selection(1, 3) = Split(.Execute(Text)(0), "x")(1)
        End If
      End If

  End With
EndS:
End Sub

Dạ em cảm ơn anh nhiều nhưng thật sự em mới bắt đầu tập tành nên rất dốt. em đã copy Code của anh và pase vào trong module nhưng không biết sử dụng sao được nhờ anh hướng dẫn giúp

HeSanbi · 25/12/18

TuanPV2803 đã viết:
Dạ em cảm ơn anh nhiều nhưng thật sự em mới bắt đầu tập tành nên rất dốt. em đã copy Code của anh và pase vào trong module nhưng không biết sử dụng sao được nhờ anh hướng dẫn giúp

Bạn đọc kĩ bài hướng dẫn chứ "copy code sau vào Code của Worksheet chứa dữ liệu của bạn"

Ba Tê · 25/12/18

TuanPV2803 đã viết:
Dạ em cảm ơn anh nhiều nhưng thật sự em mới bắt đầu tập tành nên rất dốt. em đã copy Code của anh và pase vào trong module nhưng không biết sử dụng sao được nhờ anh hướng dẫn giúp

Hướng dẫn là Copy vào VBE của sheet chứ đâu phải vào Module, chọn ô nào trong sheet code cũng chạy ???
Dùng hàm tự tạo như bài #8 xem sao.

HeSanbi · 25/12/18

Ba Tê đã viết:
chọn ô nào trong sheet code cũng chạy ???

Em sợ chủ Topic có dữ liệu nhiều cột nên cho Code chạy tự do.
Nên Em đã thêm một đoạn code giới hạn vùng Code chạy. Không biết bạn này biết sử dụng không.
Nếu bạn ấy muốn viết thành Hàm thì chuyển sang Hàm. Thấy dùng hàm sẽ không hay. Phải đánh công thức vào Ô

HieuCD · 25/12/18

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 ạ!

Dùng hàm tự tạo

Mã:

Function TachSo(iStr As String, iD As Byte)
  Dim S, tmp As String
  Dim j As Byte, n As Byte
  S = Split(StrReverse(iStr), "x")
  If iD = 1 Then tmp = S(1) Else tmp = StrReverse(S(0))
    n = Len(tmp)
    For j = 1 To n
      If IsNumeric(Mid(tmp, j, 1)) = False Then
        tmp = Mid(tmp, 1, j - 1)
        Exit For
      End If
    Next j
  If iD = 1 Then TachSo = CLng(StrReverse(tmp)) Else TachSo = CLng(tmp)
End Function

TuanPV2803 · 26/12/18

HeSanbi đã viết:
Bạn đọc kĩ bài hướng dẫn chứ "copy code sau vào Code của Worksheet chứa dữ liệu của bạn"

View attachment 209988

Anh ơi nhờ anh kiểm tra lại giúp với em coppy vào sheet1 sau đó chạy thì nó báo lỗi như hình ảnh!
Em cảm ơn anh nhiều!

Bài đã được tự động gộp: 26/12/18

HieuCD đã viết:

Dùng hàm tự tạo

Mã:

Function TachSo(iStr As String, iD As Byte)
  Dim S, tmp As String
  Dim j As Byte, n As Byte
  S = Split(StrReverse(iStr), "x")
  If iD = 1 Then tmp = S(1) Else tmp = StrReverse(S(0))
    n = Len(tmp)
    For j = 1 To n
      If IsNumeric(Mid(tmp, j, 1)) = False Then
        tmp = Mid(tmp, 1, j - 1)
        Exit For
      End If
    Next j
  If iD = 1 Then TachSo = CLng(StrReverse(tmp)) Else TachSo = CLng(tmp)
End Function

Cảm ơn sự giúp đỡ của anh! đây đúng là code em đang cần! anh có thể giải thích đôi chút về code này để em cùng các anh em có thể học hỏi được không!
Em cảm ơn anh nhiều!

batman1 · 26/12/18

TuanPV2803 đã viết:
View attachment 209999
Anh ơi nhờ anh kiểm tra lại giúp với em coppy vào sheet1 sau đó chạy thì nó báo lỗi như hình ảnh!

Code đó không chạy được đâu.

Giả sử trước khi chạy code bạn không tự tay thêm references "Microsoft VBScript Regular Expressions ..."

Tất nhiên code (hàm ý của người viết) sẽ thêm reference. Nhưng muốn code thêm reference thì nó phải được chạy. Nhưng trước khi được chạy thì code sẽ bị kiểm tra, vd. xem cú pháp có sai không, sau đó code phải được thông dịch. Mà trong quá trình này thì sẽ lòi cái lỗi "User-defined type not defined". Vì đã có reference tới "Microsoft VBScript Regular Expressions ..." đâu để mà biết VBScript_RegExp_55.RegExp nó là cái gì.

Lỗi tại dòng iRegex As New VBScript_RegExp_55.RegExp là đương nhiên.

Quá trình kiểm tra và thông dịch luôn được thực hiện trước khi chạy code. Không thể dùng bất cứ thứ gì trong thư viện mà "hiện thời" vẫn chưa có, cái chỉ có sau khi chạy code.

Bạn có 2 lựa chọn:
1. Trước khi chạy code thì tự tay thêm reference tới "Microsoft VBScript Regular Expressions ...". Trong trường hợp này code sau là thừa

Mã:

For Each ref In Application.VBE.ActiveVBProject.References
    If ref.Name = "VBScript_RegExp_55" Then isRefs = True
  Next ref
  If Not isRefs Then _
    ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\vbscript.dll\3"

2. Dùng kết nối chậm. Trong trường hợp này thì code trên cũng thừa. và phải sửa khai báo thành

Mã:

Dim iRegex As Object

Sau đó trước khi dùng đối tượng iRegex thì phải tạo nó

Mã:

Set iRegex = CreateObject("VBScript.RegExp")

TuanPV2803 · 26/12/18

batman1 đã viết:
Code đó không chạy được đâu.

Giả sử trước khi chạy code bạn không tự tay thêm references "Microsoft VBScript Regular Expressions ..."

Tất nhiên code (hàm ý của người viết) sẽ thêm reference. Nhưng muốn code thêm reference thì nó phải được chạy. Nhưng trước khi được chạy thì code sẽ bị kiểm tra, vd. xem cú pháp có sai không, sau đó code phải được thông dịch. Mà trong quá trình này thì sẽ lòi cái lỗi "User-defined type not defined". Vì đã có reference tới "Microsoft VBScript Regular Expressions ..." đâu để mà biết VBScript_RegExp_55.RegExp nó là cái gì.

Lỗi tại dòng iRegex As New VBScript_RegExp_55.RegExp là đương nhiên.

Quá trình kiểm tra và thông dịch luôn được thực hiện trước khi chạy code. Không thể dùng bất cứ thứ gì trong thư viện mà "hiện thời" vẫn chưa có, cái chỉ có sau khi chạy code.

Bạn có 2 lựa chọn:
1. Trước khi chạy code thì tự tay thêm reference tới "Microsoft VBScript Regular Expressions ...". Trong trường hợp này code sau là thừa

Mã:

For Each ref In Application.VBE.ActiveVBProject.References If ref.Name = "VBScript_RegExp_55" Then isRefs = True Next ref If Not isRefs Then _ ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\vbscript.dll\3"

2. Dùng kết nối chậm. Trong trường hợp này thì code trên cũng thừa. và phải sửa khai báo thành

Mã:

Dim iRegex As Object

Sau đó trước khi dùng đối tượng iRegex thì phải tạo nó

Mã:

Set iRegex = CreateObject("VBScript.RegExp")

Em cảm ơn anh! để xíu về em thử chạy theo anh nói hi cảm ơn sự giúp đỡ nhiệt tình của các anh!

vanthinh3101 · 26/12/18

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 ạ!

Dùng được công thức, chỉ tiếc là không áp dụng được cho dòng dữ liệu đầu tiên (dòng 11)
Bạn thử công thức sau:
Cột C

PHP:

C12=LOOKUP(10^10,--MID(LEFT(SUBSTITUTE($B12,"x",REPT(" ",20)),20),AGGREGATE(15,6,SEARCH({0,1,2,3,4,5,6,7,8,9},LEFT(SUBSTITUTE($B12,"x",REPT(" ",20)),20)),1),ROW($A$1:$A$20)))

Cột D

PHP:

D12=LOOKUP(10^10,--MID(RIGHT(SUBSTITUTE($B12,"x",REPT(" ",20)),20),AGGREGATE(15,6,SEARCH({0,1,2,3,4,5,6,7,8,9},RIGHT(SUBSTITUTE($B12,"x",REPT(" ",20)),20)),1),ROW($A$1:$A$20)))

Cả 2 đều Enter, Fill xuống

HeSanbi · 26/12/18

TuanPV2803 đã viết:
Anh ơi nhờ anh kiểm tra lại giúp với em coppy vào sheet1 sau đó chạy thì nó báo lỗi như hình ảnh!
Em cảm ơn anh nhiều!

Code trên vì nghĩ bạn chưa biết Add References nên dùng những câu lệnh Check , nếu References chưa được add thì Add vào.
Không ngờ là bạn không biết thật.
Nếu bạn add References Microsoft Regular expression 1.0 - > 5.5 bằng tay thì không cần Nhưng câu lệnh này
Khai báo New thì không sử dụng thêm Microsoft Scripting Runtime
Bạn cũng có thể sửa là: Dim iRegex As New RegExp
còn không thì phải add Microsoft Scripting Runtime, Microsoft Regular expression 1.0 - > 5.5

Đơn giản là: cửa sổ VBA -> Tools -> References... tìm và Tick
Đã muốn biết và học VBA thì bạn cần biết xử lý và sử dụng các WIN API

Lúc này :
Dim iRegex As Object
Set iRegex = CreateObject("VBScript.RegExp")

Lợi thế của Regular expression là xử lý chuỗi, cũng như tìm kiếm chuỗi rất mạnh.

Đã học VBA không nhất thiết bạn phải dựa vào một Code nào tốt nhất. Vì mỗi cái đều có lợi thế riêng

HieuCD · 26/12/18

TuanPV2803 đã viết:
View attachment 209999
Anh ơi nhờ anh kiểm tra lại giúp với em coppy vào sheet1 sau đó chạy thì nó báo lỗi như hình ảnh!
Em cảm ơn anh nhiều!

Bài đã được tự động gộp: 26/12/18

Cảm ơn sự giúp đỡ của anh! đây đúng là code em đang cần! anh có thể giải thích đôi chút về code này để em cùng các anh em có thể học hỏi được không!
Em cảm ơn anh nhiều!

Chỉnh lại code dể hiểu hơn và nhanh hơn một chút

Mã:

Function TachSo(iStr As String, iD As Byte)
  Dim S, tmp As String
  Dim j As Byte, n As Byte
  S = Split(iStr, "x")
  If iD = 1 Then tmp = StrReverse(S(UBound(S) - 1)) Else tmp = S(UBound(S))
    n = Len(tmp)
    For j = 1 To n
      If IsNumeric(Mid(tmp, j, 1)) = False Then
        tmp = Mid(tmp, 1, j - 1)
        Exit For
      End If
    Next j
  If iD = 1 Then TachSo = CLng(StrReverse(tmp)) Else TachSo = CLng(tmp)
End Function

Dữ liệu có dạng: Bz1000x450RF
Các ký tự chuỗi cuối cùng là chữ In: S = Split(iStr, "x") tách chuổi ngăn cách bằng ký tự "x" thành mảng S, với giá trị cuối S(ubound(S))= "450RF" chứa số thứ 2, và giá trị kế cuối S(ubound(S)-1)= "Bz1000" chứa số thứ 1
If iD = 1 Then tmp = StrReverse(S(UBound(S) - 1)) Else tmp = S(UBound(S))
StrReverse(S(UBound(S) - 1))="0001zB" đảo ngược của chuổi chứa số thứ 1 "Bz1000", để cả 2 thành phần đều có dạng số trước chuỗi sau,
Sau đó dò từng ký tự nếu không phải là số, là đã lấy hết các số
Mid(tmp, j, 1)="0001" : lấy 1 ký tự thú j
If IsNumeric(Mid(tmp, j, 1)) = False Then : Nếu ký tự thứ j không phải là số thì lấy kết quả là các ký tự từ 1 tới j-1
tmp = Mid(tmp, 1, j - 1)
Do chuổi số thứ 1 đã bị đảo ngược nên kết quả phải đảo ngược lại
If iD = 1 Then TachSo = CLng(StrReverse(tmp)) Else TachSo = CLng(tmp)
Hàm Clng chuyển chuỗi thành số nguyên

Phan Thế Hiệp · 26/12/18

vanthinh3101 đã viết:
Dùng được công thức, chỉ tiếc là không áp dụng được cho dòng dữ liệu đầu tiên (dòng 11)

Không cần phải tiếc em!

Dùng công thức mảng như sau:

Mã:

C11=LOOKUP(10^10, --MID("|"&$B11,SMALL(IF(FREQUENCY(-ROW($1:$50),ISERR(--MID("|"&$B11,ROW($1:$50),1))*-ROW($1:$50))>2,ROW($1:$50)),COLUMN(A11))+1,{3,4}))

Kết thúc bằng Ctrl+Shift+Enter, fill qua phải 1 cột, rồi fill cả hai cột C: D xuống dưới.

Chúc em ngày vui.
/-*+/

excel_lv1.5 · 26/12/18

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 ạ!

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)))

CHAOQUAY · 26/12/18

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 ạ!

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

VetMini · 26/12/18

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

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.

HeSanbi · 27/12/18

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

HieuCD · 27/12/18

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

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 ?

VetMini · 27/12/18

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 ?

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.

HeSanbi · 27/12/18

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 ?

Ý 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

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 = ""

Nhất Chi Lan · 27/12/18

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

huuthang_bd · 27/12/18

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

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ất Chi Lan · 27/12/18

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.

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

huuthang_bd · 27/12/18

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

Đâ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

PacificPR · 27/12/18

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

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

VetMini · 27/12/18

Chủ bài #30:
Bạn cố gắng quá độ cho nên code bị lỏng.
1. Thử số 1,234.5 xem
2. Thử vấn đề tôi nói ở bài #26 xem

huuthang_bd · 27/12/18

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

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,".")

PacificPR · 27/12/18

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,".")

Hay là mình tìm cái dấu thập phân bằng lệnh này ạ: Application.DecimalSeparator

TuanPV2803 · 27/12/18

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ị!

huuthang_bd · 27/12/18

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

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?

Phan Thế Hiệp · 28/12/18

TuanPV2803 đã viết:
mong các anh chị chỉ bảo địa điểm có thể đă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ị!

Xem link:
Lịch [KHAI GIẢNG] các Khóa học Excel tháng 12/2018
[KHỞI ĐỘNG] Năm mới cùng các Khóa học Excel tháng 1/2019

Thân

TuanPV2803 · 28/12/18

Phan Thế Hiệp đã viết:
Xem link:
Lịch [KHAI GIẢNG] các Khóa học Excel tháng 12/2018
[KHỞI ĐỘNG] Năm mới cùng các Khóa học Excel tháng 1/2019

Thân

Em cảm ơn anh nhiều!

Xử lý Chuỗi, tách số ra khỏi chuỗi (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên mới

File đính kèm

Thành viên mới

Thành viên hoạt động

Cạo Rồi Khỏi Gội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Lỡ bước sang ngang

File đính kèm

Thành viên mới

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Cạo Rồi Khỏi Gội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên tích cực

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

-⍟-

File đính kèm

Thành viên tích cực

Thành viên gắn bó

Đang đi tìm hòn đá

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

Đang đi tìm hòn đá

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên mới

File đính kèm

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Đang đi tìm hòn đá

Chuyên gia GPE

Thành viên mới

Thành viên mới

Chuyên gia GPE

-⍟-

Thành viên mới

Thời gian đếm ngược.