Sub Tach_()
Dim Nguon, Dong
Dim Tam
Dim Kq
Dim i, j, k, x1, x2, z1, z2, t1, t2, y, spt
Nguon = Sheet1.Range("A1").CurrentRegion
Dong = UBound(Nguon)
ReDim Kq(1 To Dong - 1, 1 To 6)
For i = 2 To Dong
Tam = Split(Nguon(i, 2))
spt = UBound(Tam)
For j = spt To 0 Step -1
If IsNumeric(Tam(j)) = True Then
k = j + 1
Exit For
End If
Next j
y = 0
x1 = 1: x2 = 1
For j = 2 To k
t1 = Mid(Tam(j - 1), 1, 1)
t2 = Mid(Tam(j), 1, 1)
If IsNumeric(t2) = False And t2 = UCase(t2) Then
If IsNumeric(t1) = False And t1 = UCase(t1) Then
If y = 0 Then
x2 = x2 + 1
Else
If y = 1 Then
z1 = j - 1
z2 = j
y = y + 1
Else
z2 = z2 + 1
End If
End If
End If
Else
y = 1
End If
Next j
Kq(i - 1, 1) = Tam(0)
For j = 1 To spt
If j <= x2 Then
Kq(i - 1, 2) = Kq(i - 1, 2) & " " & Tam(j)
Else
If j < z1 Then
Kq(i - 1, 3) = Kq(i - 1, 3) & " " & Tam(j)
Else
If j <= z2 Then
Kq(i - 1, 4) = Kq(i - 1, 4) & " " & Tam(j)
Else
If j < k Then
Kq(i - 1, 6) = Kq(i - 1, 6) & " " & Tam(j)
Else
Kq(i - 1, 5) = Kq(i - 1, 5) & " " & Tam(j)
End If
End If
End If
End If
Next j
Next i
With Sheet1
.Range("C2").Resize(Dong - 1, 6).ClearContents
.Range("C2").Resize(Dong - 1, 6) = Kq
.UsedRange.Columns.AutoFit
End With
End Sub
