Tìm quy luật tách chuỗi dữ liệu

Quảng cáo

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29
Mình thử thấy bài #6 có ra kết quả mà, vẫn chưa đúng ý à
Uhm. Đúng ý rồi à. Ý là em trả lời code #8. Em thấy code gần trọn vẹn rồi. Em thấy có trường hợp trước số mà không có dấu nháy đơn thì nó không tách được.
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,786
Được thích
15,642
Điểm
4,668
Chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

Em muốn nhờ mọi người tìm quy luật tách chuỗi này.
Em cần lấy những con số trong file đính kèm mà em.vẫn chưa tìm ra được quy luật.
Em vẫn chưa tìm được quy luật tách chuỗi. Mọi người xem có thể xem và hỗ trợ em vấn đề này không?
Em cảm ơn mọi người nhiều!
Chạy code
Mã:
Sub ABC()
  Dim sArr(), Res() As String, iChar$
  Dim i&, N&, j&, j2&, k&, jC&
 
  sArr = Range("A5", Range("A" & Rows.Count).End(xlUp)).Value
  srow = UBound(sArr)
  ReDim Res(1 To srow, 1 To 10)
  For i = 1 To srow
    tmp = sArr(i, 1)
    N = Len(tmp)
    jC = 0
    For j = 1 To N - 6
      If IsNumeric(Mid(tmp, j, 1)) Then
        k = 1
        For j2 = j + 1 To N
          iChar = Mid(tmp, j2, 1)
          If IsNumeric(iChar) Or iChar = " " Then
            k = k + 1
          Else
            j2 = j2 + 1: Exit For
          End If
        Next j2
        If k > 5 Then
          jC = jC + 1
          Res(i, jC) = Trim(Mid(tmp, j, k))
        End If
        j = j2 - 1
      End If
    Next j
  Next i
  Range("B5").Resize(srow, 10) = Res
End Sub
 

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29
Chạy code
Mã:
Sub ABC()
  Dim sArr(), Res() As String, iChar$
  Dim i&, N&, j&, j2&, k&, jC&

  sArr = Range("A5", Range("A" & Rows.Count).End(xlUp)).Value
  srow = UBound(sArr)
  ReDim Res(1 To srow, 1 To 10)
  For i = 1 To srow
    tmp = sArr(i, 1)
    N = Len(tmp)
    jC = 0
    For j = 1 To N - 6
      If IsNumeric(Mid(tmp, j, 1)) Then
        k = 1
        For j2 = j + 1 To N
          iChar = Mid(tmp, j2, 1)
          If IsNumeric(iChar) Or iChar = " " Then
            k = k + 1
          Else
            j2 = j2 + 1: Exit For
          End If
        Next j2
        If k > 5 Then
          jC = jC + 1
          Res(i, jC) = Trim(Mid(tmp, j, k))
        End If
        j = j2 - 1
      End If
    Next j
  Next i
  Range("B5").Resize(srow, 10) = Res
End Sub
Cảm ơn Anh nhiều! Có gì em test rồi phản hồi lại cho Anh.
 

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29

dazkangel

<New Horizons>
Tham gia ngày
28 Tháng hai 2017
Bài viết
2,926
Được thích
3,956
Điểm
1,368
Nơi ở
Đồng Nai

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29

dazkangel

<New Horizons>
Tham gia ngày
28 Tháng hai 2017
Bài viết
2,926
Được thích
3,956
Điểm
1,368
Nơi ở
Đồng Nai
Anh có thể đưa lên cho mọi người tham khảo đó Anh.
Công thức cuối cùng :eek: :eek: khỏi xài conditional formatting.
Mã:
=IFERROR(MID(TEXT(AGGREGATE(14,6,--(1&MID(SUBSTITUTE($A5," ","")&"'",ROW(INDIRECT("1:"&LEN($A5))),{6,8,13})),COLUMN(A:A)),"[>"&REPT(9,TEXT(LEN(A5),"[=0]13;[>13]1;0"))&"]#;"),2,13),"")
 
Lần chỉnh sửa cuối:

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,640
Được thích
1,916
Điểm
868
Code của Anh ban đầu tách gần hết rồi đó Anh. Trường hợp trước những chuỗi số không có dấu nháy ' thì nó chưa tách được thôi.
Nếu bạn muốn tách 6 số trở lên thì thay thế hàm scraper sau cho hàm scraper ở code trên

JavaScript:
Private Function scraper(ByVal text$, Optional ByRef re As Object)
  scraper = Array("")
  If re Is Nothing Then
    Set re = VBA.CreateObject("VBScript.RegExp")
    With re
      .Global = True
      .IgnoreCase = True
      .MultiLine = True
      .pattern = "\d{6,30}"
    End With
  End If
  Dim m, ms, t$, i%, k%, Arr()
  Set ms = re.Execute(text)
  If ms.Count Then
    ReDim Arr(ms.Count - 1)
    For i = 0 To ms.Count - 1
      Arr(i) = ms(i)
    Next
    scraper = Arr
  End If
End Function
 

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29
Nếu bạn muốn tách 6 số trở lên thì thay thế hàm scraper sau cho hàm scraper ở code trên

JavaScript:
Private Function scraper(ByVal text$, Optional ByRef re As Object)
  scraper = Array("")
  If re Is Nothing Then
    Set re = VBA.CreateObject("VBScript.RegExp")
    With re
      .Global = True
      .IgnoreCase = True
      .MultiLine = True
      .pattern = "\d{6,30}"
    End With
  End If
  Dim m, ms, t$, i%, k%, Arr()
  Set ms = re.Execute(text)
  If ms.Count Then
    ReDim Arr(ms.Count - 1)
    For i = 0 To ms.Count - 1
      Arr(i) = ms(i)
    Next
    scraper = Arr
  End If
End Function
Trường hợp chuỗi số không có dấu nháy đơn đầu có tách được không Anh.
 

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia ngày
17 Tháng tư 2016
Bài viết
2,543
Được thích
2,145
Điểm
1,368
Tuổi
29
Nếu bạn muốn tách 6 số trở lên thì thay thế hàm scraper sau cho hàm scraper ở code trên

JavaScript:
Private Function scraper(ByVal text$, Optional ByRef re As Object)
  scraper = Array("")
  If re Is Nothing Then
    Set re = VBA.CreateObject("VBScript.RegExp")
    With re
      .Global = True
      .IgnoreCase = True
      .MultiLine = True
      .pattern = "\d{6,30}"
    End With
  End If
  Dim m, ms, t$, i%, k%, Arr()
  Set ms = re.Execute(text)
  If ms.Count Then
    ReDim Arr(ms.Count - 1)
    For i = 0 To ms.Count - 1
      Arr(i) = ms(i)
    Next
    scraper = Arr
  End If
End Function
Em cảm ơn Anh nhiều!
Code Anh đã tách hết các trường hợp.

Em cảm ơn Anh nhiều!
 
Quảng cáo
Top Bottom