Sub tach_chuoi()
Dim Arr(), Res(), i As Long, Lr As Long, k As Long, b2 As Long
Dim dem As Long, a As Long, b As Long, b1 As Long
With Sheets("Sheet1")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("B6:B" & Lr).Value
ReDim Res(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" Then
k = k + 1
For a = 1 To Len(Arr(i, 1))
If Mid(Arr(i, 1), a, 1) = chr(10) Then
dem = dem + 1
End If
Next a
If dem = 1 Then
b = InStr(Arr(i, 1), chr(10))
Res(k, 1) = Mid(Arr(i, 1), 1, b - 1)
Res(k, 2) = Trim(Mid(Arr(i, 1), b + 1, 100))
Res(k, 3) = Trim(Mid(Arr(i, 1), b + 1, 100))
ElseIf dem = 2 Then
b1 = InStr(Arr(i, 1), "O")
b2 = InStr(Arr(i, 1), "I")
Res(k, 1) = Mid(Arr(i, 1), 1, b1 - 1)
Res(k, 2) = Trim(Mid(Arr(i, 1), b1 + 6, b2 - b1 - 6))
Res(k, 3) = Trim(Mid(Arr(i, 1), b2 + 7, 100))
End If
dem = 0: b = 0: b1 = 0: b2 = 0
End If
Next i
.Range("G6").Resize(k, 3).Value = Res
End With
End Sub