Trích xuất dữ liệu số trong chuỗi kí tự

Liên hệ QC

lenguyenkhai

Thành viên mới
Tham gia
23/4/16
Bài viết
26
Được thích
2
Các pro giúp mình viết công thức các ô cho trường hợp dưới với nhé. Cám ơn mọi người

1585871040176.png

Mô tả:
-Dòng "10": là dòng bao gồm các kí tự hoặc chuỗi kí tự cần tìm số đi kèm liền trước nó trong chuỗi nguồn (chuỗi kí tự ở cột P & Q)
-Giá trị cần xuất ở các cột từ "R" đến "AA" là giá trị số đi kèm liền trước chuỗi cần tìm (dòng 10) (với trường hợp trước nó không có giá trị số nào thì kết quả hiển thị là "1", nếu chuỗi cần tìm không xuất hiện trong chuỗi nguồn thì kết quả trả về "0") (xem ví dụ ô U149 & Y149)
 
Các pro giúp mình viết công thức các ô cho trường hợp dưới với nhé. Cám ơn mọi người

View attachment 234602

Mô tả:
-Dòng "10": là dòng bao gồm các kí tự hoặc chuỗi kí tự cần tìm số đi kèm liền trước nó trong chuỗi nguồn (chuỗi kí tự ở cột P & Q)
-Giá trị cần xuất ở các cột từ "R" đến "AA" là giá trị số đi kèm liền trước chuỗi cần tìm (dòng 10) (với trường hợp trước nó không có giá trị số nào thì kết quả hiển thị là "1", nếu chuỗi cần tìm không xuất hiện trong chuỗi nguồn thì kết quả trả về "0") (xem ví dụ ô U149 & Y149)
Bác nào giúp em với ....
 
Các pro giúp mình viết công thức các ô cho trường hợp dưới với nhé. Cám ơn mọi người

View attachment 234602

Mô tả:
-Dòng "10": là dòng bao gồm các kí tự hoặc chuỗi kí tự cần tìm số đi kèm liền trước nó trong chuỗi nguồn (chuỗi kí tự ở cột P & Q)
-Giá trị cần xuất ở các cột từ "R" đến "AA" là giá trị số đi kèm liền trước chuỗi cần tìm (dòng 10) (với trường hợp trước nó không có giá trị số nào thì kết quả hiển thị là "1", nếu chuỗi cần tìm không xuất hiện trong chuỗi nguồn thì kết quả trả về "0") (xem ví dụ ô U149 & Y149)
Đọc yêu cầu của bạn chưa hiểu gì. Bạn nêu rõ tí tí. Mình đọc chẳng hiểu. Quy luật tách ra sao?
 
Các pro giúp mình viết công thức các ô cho trường hợp dưới với nhé. Cám ơn mọi người

View attachment 234602

Mô tả:
-Dòng "10": là dòng bao gồm các kí tự hoặc chuỗi kí tự cần tìm số đi kèm liền trước nó trong chuỗi nguồn (chuỗi kí tự ở cột P & Q)
-Giá trị cần xuất ở các cột từ "R" đến "AA" là giá trị số đi kèm liền trước chuỗi cần tìm (dòng 10) (với trường hợp trước nó không có giá trị số nào thì kết quả hiển thị là "1", nếu chuỗi cần tìm không xuất hiện trong chuỗi nguồn thì kết quả trả về "0") (xem ví dụ ô U149 & Y149)
Dữ liệu rất linh tinh.Khó kiểm soát.Bạn gửi file lên xem nào.
 
Xin lỗi mọi người, mình không tìm thấy cách add file vào bài mở đầu nên đành add vào dưới này, các bác thông cảm. Các bác tham khảo file mình cần tách phần số đi kèm liền trước các chuỗi kí tự như đã mô tả ở trên với nhé.
 

File đính kèm

  • 1F.xlsx
    81.4 KB · Đọc: 25
Lần chỉnh sửa cuối:
Xin lỗi mọi người, mình không tìm thấy cách add file vào bài mở đầu nên đành add vào dưới này, các bác thông cảm. Các bác tham khảo file mình cần tách phần số đi kèm liền trước các chuỗi kí tự như đã mô tả ở trên với nhé.
Bạn thử.
 

File đính kèm

  • 1F.xlsm
    93.8 KB · Đọc: 31
Bác snow25 có thể cho mình hỏi nếu mình có những file khác tương tự như vậy thì nếu cần tách xuất dữ liệu như file mẫu mình đã gửi thì có cách làm nào hay không ?
Bạn copy cái code ở file này sang file đó chạy là được.Bấm Alt+F11 là thấy code nhé.Còn cách chạy code bạn bấm F5 nhé.
 
Bác snow25 ơi, nếu trường hợp trong chuỗi gốc (cột "O" theo hình bên dưới) tồn tại như ví dụ ở O12 (các dạng chuỗi cần trích lấy số như "M," được lặp lại nhiều lần trong chuỗi). Bác xem có thể sửa code lại để được cho cả trường hợp này không bác? ^_^
1586334556913.png
 
Bác snow25 ơi, nếu trường hợp trong chuỗi gốc (cột "O" theo hình bên dưới) tồn tại như ví dụ ở O12 (các dạng chuỗi cần trích lấy số như "M," được lặp lại nhiều lần trong chuỗi). Bác xem có thể sửa code lại để được cho cả trường hợp này không bác? ^_^
View attachment 235086
Lặp lại thì cộng thêm à bạn.
 
Đúng rồi bạn, nó cộng tất cả các số có chuỗi yêu cầu trích xuất số lại như ở hình ví dụ mình post ở trên.
Bạn thử code này nhé.
Mã:
Sub laydulieu()
    Dim arr, i As Long, j As Long, s As String, data, k As Long, s1 As String, a As Long, lr As Long, T, n As Long, s2 As String, s3 As String
    With Sheets("Export from CAD")
         lr = .Range("O" & Rows.Count).End(xlUp).Row
         data = .Range("r10:ac10").Value
         arr = .Range("O12:O" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 12)
         For i = 1 To UBound(arr)
             s = arr(i, 1)
             For k = 12 To 1 Step -1
                 s1 = data(1, k)
                 T = Split(s1 & "#" & s, s1)
                 a = UBound(T) - 1
                 If a Then
                    For n = 1 To a
                        s2 = T(n)
                        kq(i, k) = kq(i, k) + layso(s2)
                        s3 = kq(i, k) & s1
                        s = Replace(s, s3, "")
                    Next n
                        s = Replace(s, s1, "")
                 End If
            Next k
        Next i
             .Range("r12:ac12").Resize(i - 1).Value = kq
    End With
End Sub
    Function layso(ByVal ten As String) As Long
             Dim i As Long, a As Long
                 For i = Len(ten) To 1 Step -1
                     If IsNumeric(Mid(ten, i, 1)) Then
                      If a > 0 Then a = Mid(ten, i, 1) & a Else a = Mid(ten, i, 1)
                     Else
                        Exit For
                     End If
                 Next i
                 If a = 0 Then a = 1
                 layso = a
    End Function
 
Bạn thử code này nhé.
Mã:
Sub laydulieu()
    Dim arr, i As Long, j As Long, s As String, data, k As Long, s1 As String, a As Long, lr As Long, T, n As Long, s2 As String, s3 As String
    With Sheets("Export from CAD")
         lr = .Range("O" & Rows.Count).End(xlUp).Row
         data = .Range("r10:ac10").Value
         arr = .Range("O12:O" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 12)
         For i = 1 To UBound(arr)
             s = arr(i, 1)
             For k = 12 To 1 Step -1
                 s1 = data(1, k)
                 T = Split(s1 & "#" & s, s1)
                 a = UBound(T) - 1
                 If a Then
                    For n = 1 To a
                        s2 = T(n)
                        kq(i, k) = kq(i, k) + layso(s2)
                        s3 = kq(i, k) & s1
                        s = Replace(s, s3, "")
                    Next n
                        s = Replace(s, s1, "")
                 End If
            Next k
        Next i
             .Range("r12:ac12").Resize(i - 1).Value = kq
    End With
End Sub
    Function layso(ByVal ten As String) As Long
             Dim i As Long, a As Long
                 For i = Len(ten) To 1 Step -1
                     If IsNumeric(Mid(ten, i, 1)) Then
                      If a > 0 Then a = Mid(ten, i, 1) & a Else a = Mid(ten, i, 1)
                     Else
                        Exit For
                     End If
                 Next i
                 If a = 0 Then a = 1
                 layso = a
    End Function
Bác ơi, bác chỉnh lại giúp phần cộng các đối tượng, nó cộng luôn các kí tự trong chuỗi (nhầm lẫn "M" & "M," khi cần trích xuất số lượng "M" thì nó đếm cả M trong "M," như ở minh họa bên dưới:
1586431398391.png
 
Bác ơi, bác chỉnh lại giúp phần cộng các đối tượng, nó cộng luôn các kí tự trong chuỗi (nhầm lẫn "M" & "M," khi cần trích xuất số lượng "M" thì nó đếm cả M trong "M," như ở minh họa bên dưới:
View attachment 235197
Bạn thử cái này nhé.
Mã:
Sub laydulieu()
    Dim arr, i As Long, j As Long, s As String, data, k As Long, s1 As String, a As Long, lr As Long, T, n As Long, s2 As String, s3 As String, m As Long
    With Sheets("Export from CAD")
         lr = .Range("O" & Rows.Count).End(xlUp).Row
         data = .Range("r10:ac10").Value
         arr = .Range("O12:O" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 12)
         For i = 1 To UBound(arr)
             s = arr(i, 1)
             For k = 12 To 1 Step -1
                 s1 = data(1, k)
                 T = Split(s1 & "#" & s, s1)
                 a = UBound(T) - 1
                 If a Then
                    For n = 1 To a
                        s2 = T(n)
                        m = layso(s2)
                        kq(i, k) = kq(i, k) + m
                        s3 = m & s1
                        s = Replace(s, s3, "")
                    Next n
                        s = Replace(s, s1, "")
                 End If
            Next k
        Next i
             .Range("r12:ac12").Resize(i - 1).Value = kq
    End With
End Sub
    Function layso(ByVal ten As String) As Long
             Dim i As Long, a As Long
                 For i = Len(ten) To 1 Step -1
                     If IsNumeric(Mid(ten, i, 1)) Then
                      If a > 0 Then a = Mid(ten, i, 1) & a Else a = Mid(ten, i, 1)
                     Else
                        Exit For
                     End If
                 Next i
                 If a = 0 Then a = 1
                 layso = a
    End Function
 
Bạn thử cái này nhé.
Mã:
Sub laydulieu()
    Dim arr, i As Long, j As Long, s As String, data, k As Long, s1 As String, a As Long, lr As Long, T, n As Long, s2 As String, s3 As String, m As Long
    With Sheets("Export from CAD")
         lr = .Range("O" & Rows.Count).End(xlUp).Row
         data = .Range("r10:ac10").Value
         arr = .Range("O12:O" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 12)
         For i = 1 To UBound(arr)
             s = arr(i, 1)
             For k = 12 To 1 Step -1
                 s1 = data(1, k)
                 T = Split(s1 & "#" & s, s1)
                 a = UBound(T) - 1
                 If a Then
                    For n = 1 To a
                        s2 = T(n)
                        m = layso(s2)
                        kq(i, k) = kq(i, k) + m
                        s3 = m & s1
                        s = Replace(s, s3, "")
                    Next n
                        s = Replace(s, s1, "")
                 End If
            Next k
        Next i
             .Range("r12:ac12").Resize(i - 1).Value = kq
    End With
End Sub
    Function layso(ByVal ten As String) As Long
             Dim i As Long, a As Long
                 For i = Len(ten) To 1 Step -1
                     If IsNumeric(Mid(ten, i, 1)) Then
                      If a > 0 Then a = Mid(ten, i, 1) & a Else a = Mid(ten, i, 1)
                     Else
                        Exit For
                     End If
                 Next i
                 If a = 0 Then a = 1
                 layso = a
    End Function
Bác xem giúp mình file đính kèm, mình copy thay thế nhưng kết quả vẫn không thay đổi bác ah.
 

File đính kèm

  • Attic.rar
    404.5 KB · Đọc: 13
Web KT
Back
Top Bottom