Nhờ lọc bớt chữ của tên sản phẩm cho gọn lại bằng vba (1 người xem)

[thanhphan157]

Mình có 1 file sản phẩm tên dài ngoằng và muốn cắt bớt để cho gọn lại như kết quả ở đầu ra.
File đính kèm

 

[huuthang_bd]

Mình có 1 file sản phẩm tên dài ngoằng và muốn cắt bớt để cho gọn lại như kết quả ở đầu ra.
File đính kèm

Làm theo dữ liệu trong file:

Function RutGon(Byval Str As String) As String
Static oReg As Object
If oReg Is Nothing Then
    Set oReg = CreateObject("VBScript.RegExp")
    oReg.Pattern = "^(.*[A-Z]{2,}).*:\D*([0-9\.]+)[Mm]{2}[Xx]([0-9\.]+)[Mm]{2}.*$"
End If
RutGon = oReg.Replace(Str, "$1 Ø$2 x $3")
End Function

 

[ndu96081631]

Làm theo dữ liệu trong file:

Function RutGon(Byval Str As String) As String
Static oReg As Object
If oReg Is Nothing Then
    Set oReg = CreateObject("VBScript.RegExp")
    oReg.Pattern = "^(.*[A-Z]{2,}).*:\D*([0-9\.]+)[Mm]{2}[Xx]([0-9\.]+)[Mm]{2}.*$"
End If
RutGon = oReg.Replace(Str, "$1 Ø$2 x $3")
End Function

Dấu hiệu nhận biết cũng chưa rõ ràng lắm! Cái này mà gặp Ống nhựa Bình Minh ...... 21mmX1.5mmX4.0m thì coi như không rút gọn được gì.
Nếu như tác giả tạo ra 1 danh sách chuẩn để rút gọn theo nó thì công việc sẽ dễ dàng hơn

 

[phulien1902]

Mình có 1 file sản phẩm tên dài ngoằng và muốn cắt bớt để cho gọn lại như kết quả ở đầu ra.
File đính kèm

1 cách, chỉ đúng với bài toán của bạn:

Sub abc()
    Dim a As Range, i As Long
    For i = 2 To Range("A" & Rows.Count).End(3).Row
        Set a = Range("a" & i)
        If a = "" Then Exit Sub
        Range("B" & i) = Left(Range("a" & i), 13)
        With Range("C" & i)
            .Value = Split(a, ":")(1)
            .Replace "mm", ""
            .Replace "x4.0m", ""
            .Replace "X", "x"
            .Value = "Ø" & Trim(.Value)
        End With
        Range("B" & i) = Left(Range("a" & i), 13)
        Range("B" & i) = Range("B" & i) & " " & Range("C" & i)
        Range("C" & i).ClearContents
    Next
End Sub

 

[thanhphan157]

Làm theo dữ liệu trong file:

Function RutGon(Byval Str As String) As String
Static oReg As Object
If oReg Is Nothing Then
    Set oReg = CreateObject("VBScript.RegExp")
    oReg.Pattern = "^(.*[A-Z]{2,}).*:\D*([0-9\.]+)[Mm]{2}[Xx]([0-9\.]+)[Mm]{2}.*$"
End If
RutGon = oReg.Replace(Str, "$1 Ø$2 x $3")
End Function

Cảm ơn bạn huuthang_bd, mình chỉ cần lấy được $2x$3 là đủ rồi