Tách nội dung ra khỏi chuỗi - nhờ giúp đỡ

[caovanhau1507]

Trường hợp dòng 12-13 trong file bài 14 thì sẽ thế nào

Sẽ trở thành 80/36/1 - 125/72/1

 

[doatmenhhon]

Sẽ trở thành 80/36/1 - 125/72/1

Trả lời tất cả các ý trên của bạn. Tạm biệt mãi mãi.

Function Rut(s As String) As String
Dim arr As Object, tach, t1, t2, t3, t4 As String, i, j As Integer
Dim x, y, u, z, z1, z2
With CreateObject("VBScript.RegExp")
     .Global = True
     .ignorecase = True
     .Pattern = "(\d{1,3})[A-Z]?(\-)?(\d{1,3})[A-Z]?[\/](\s?\d{1,2})([A-Z]?)[\/]?(\s?\d{0,3})[A-Z]?(\-)?(\d{1,3})[A-Z]?|set|recycle|(full)\s*(dull)|(plastic)\s*(tube)"
     If .Test(s) Then Set arr = .Execute(s)
  For i = 0 To arr.Count - 1
  tach = tach & arr(i)
  Select Case True
    Case UCase(arr(i)) Like "*SET*": t1 = "Set "
    Case UCase(arr(i)) Like "*FULL*DULL*": t2 = " FD"
    Case UCase(arr(i)) Like "*RECYCLE*": t3 = " Recycle"
    Case UCase(arr(i)) Like "*PLASTIC*TUBE*": t4 = " Plastic Tube"
  End Select
  Next i
  For j = 1 To Len(tach)
    If Mid(tach, j, 1) Like "#" Or Mid(tach, j, 1) Like "/" Or Mid(tach, j, 1) Like "-" Then Rut = Rut & Mid(tach, j, 1)
  Next j
x = Split(Rut, "/")
y = Split(Rut, "-")
If UBound(y) > 0 Then
    z = Split(y(1), "/")
    Rut = y(0) & "/" & z(1) & "-" & z(0) & "/" & y(UBound(y))
End If
If UBound(x) = 1 And UBound(y) = 0 Then Rut = Rut & "/1"
u = Split(Rut, "-")
If UBound(u) = 1 Then
    z1 = Split(u(0), "/")
    z2 = Split(u(1), "/")
    If UBound(z1) = 1 Then z1 = u(0) & "/1"
    If UBound(z2) = 1 Then z2 = u(1) & "/1"
    Rut = z1 & "-" & z2
End If
Rut = t1 & Rut & t2 & t3 & t4
End With
End Function

Công thức = rut [a2]

 

[VetMini]

Goodbye forever

Comprehend decease continuous.

 

[caovanhau1507]

Cảm ơn anh rất nhiều,

Xin lỗi nếu e đã làm phiền

Thank các anh chị của GPE

 

[doatmenhhon]

Comprehend decease continuous.

Dạ em xin sửa lại theo ý thầy.

 

[TheThienChu]

Trả lời tất cả các ý trên của bạn. Tạm biệt mãi mãi.

Function Rut(s As String) As String
Dim arr As Object, tach, t1, t2, t3, t4 As String, i, j As Integer
Dim x, y, u, z, z1, z2
With CreateObject("VBScript.RegExp")
     .Global = True
     .ignorecase = True
     .Pattern = "(\d{1,3})[A-Z]?(\-)?(\d{1,3})[A-Z]?[\/](\s?\d{1,2})([A-Z]?)[\/]?(\s?\d{0,3})[A-Z]?(\-)?(\d{1,3})[A-Z]?|set|recycle|(full)\s*(dull)|(plastic)\s*(tube)"
     If .Test(s) Then Set arr = .Execute(s)
  For i = 0 To arr.Count - 1
  tach = tach & arr(i)
  Select Case True
    Case UCase(arr(i)) Like "*SET*": t1 = "Set "
    Case UCase(arr(i)) Like "*FULL*DULL*": t2 = " FD"
    Case UCase(arr(i)) Like "*RECYCLE*": t3 = " Recycle"
    Case UCase(arr(i)) Like "*PLASTIC*TUBE*": t4 = " Plastic Tube"
  End Select
  Next i
  For j = 1 To Len(tach)
    If Mid(tach, j, 1) Like "#" Or Mid(tach, j, 1) Like "/" Or Mid(tach, j, 1) Like "-" Then Rut = Rut & Mid(tach, j, 1)
  Next j
x = Split(Rut, "/")
y = Split(Rut, "-")
If UBound(y) > 0 Then
    z = Split(y(1), "/")
    Rut = y(0) & "/" & z(1) & "-" & z(0) & "/" & y(UBound(y))
End If
If UBound(x) = 1 And UBound(y) = 0 Then Rut = Rut & "/1"
u = Split(Rut, "-")
If UBound(u) = 1 Then
    z1 = Split(u(0), "/")
    z2 = Split(u(1), "/")
    If UBound(z1) = 1 Then z1 = u(0) & "/1"
    If UBound(z2) = 1 Then z2 = u(1) & "/1"
    Rut = z1 & "-" & z2
End If
Rut = t1 & Rut & t2 & t3 & t4
End With
End Function

Công thức = rut [a2]

Code hay quá.
pattern hay quá.
Việc của chủ thớt được giải quyết .
Good luck!