xin hướng dẫn cách tách ký tự

[huuthang1805]

chào anh chị
nhờ mọi người chỉ giúp em công thức tách chuỗi theo file này với ạ

cám ơn mọi người

 

[dangductuong2125]

Trong khi chờ cách làm khác hay hơn dùng tạm file này.

 

[cantl]

Cách có thể bị lỗi:

Option Explicit

Public Function ChuoiTuChuoi(CellChuoi As Range) As String
    Dim Regex As Object
    Dim Chuoi As Object
    Set Regex = CreateObject("vbscript.regexp")
    With Regex
        .Global = True
        .Pattern = "H\d+xW\d+xD\d+"
        Set Chuoi = Regex.Execute(CellChuoi)
    End With
    ChuoiTuChuoi = Chuoi(0)
End Function

Function tachso(CellChuoi As Range)
Dim arr As Variant
Dim i&
arr = Split(ChuoiTuChuoi(CellChuoi), "x")
For i = LBound(arr) To UBound(arr)
arr(i) = Mid(arr(i), 2, Len(arr(i)))
Next
tachso = arr
End Function

Ghi bác: Các bác có cách nào lấy trực tiếp 3 số bằng regex (bỏ qua H, W, D) luôn không ạ?

 

[VetMini]

...
PS: Các bác có cách nào lấy trực tiếp 3 số bằng regex (bỏ qua H, W, D) luôn không ạ?

Đối với tôi, ps là tiếng Tây nhé (postscript - từ tiếng Latin postscriptum; nghĩa là write after)

Sub t()
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\bH(\d+)xW(\d+)xD(\d+)\b"
For Each eMatch In .Execute("vvvv vvv vvvvvvv H100xW123xD456 nnnnnnn nnnn")
For Each eVal In eMatch.Submatches
MsgBox eVal
Next eVal
Next eMatch
End With
End Sub

 

[cantl]

Đối với tôi, ps là tiếng Tây nhé (postscript - từ tiếng Latin postscriptum; nghĩa là write after)

Hehe, bác thật là thánh soi.
Tìm hiểu code bác Vet thì em mới hiểu mờ mờ.

Option Explicit

Public Function tachso2(CellChuoi As Range)
    Dim Regex As Object
    Dim Chuoi As Object
    Dim eVal, arrReg(2), i
    Set Regex = CreateObject("vbscript.regexp")
    With Regex
        .Global = True
        .Pattern = "\bH(\d+)xW(\d+)xD(\d+)\b"
    End With
    Set Chuoi = Regex.Execute(CellChuoi)
    For Each eVal In Chuoi(0).SubMatches
        arrReg(i) = eVal
        i = i + 1
    Next eVal
    tachso2 = arrReg
End Function

 

[CHAOQUAY]

@huuthang1805 Tham khảo

Option Explicit

Sub abc()
Dim DL
Dim KQ
Dim i, j

DL = Sheet1.Range("A6").CurrentRegion
ReDim KQ(1 To UBound(DL), 1 To 3)

With CreateObject("VbScript.RegExp")
    .Global = True
    .Pattern = "\d+"
    For i = 1 To UBound(DL)
        For j = 0 To 2
            KQ(i, j + 1) = .Execute(DL(i, 1))(j)
        Next j
    Next i
End With

Sheet1.Range("C6").Resize(UBound(KQ), 3) = KQ
End Sub

 

[VetMini]

Hehe, bác thật là thánh soi.
...

Đó là quan niệm chủ quan của những người không thích cách làm việc của tôi.
Không dị ứng thì bắt buộc phải soi mới thấy.
Với người có dị ứng thì nó chỏi mắt ngay. Phản ứng tự nhiên, không cần qua suy nghĩ.
Bạn bảo tôi "soi" là coi thường khả năng nhận thức "các điểm bất thường" của tôi. Nhờ khả năng này mà tôi vượt qua rất nhiều rắc rối khi giải bài.