Oanhnhunguyen2610
Thành viên mới

- Tham gia
- 24/3/20
- Bài viết
- 26
- Được thích
- 0
Hướng dẫn làm thủ công, bạn tự làm nhé:Chào Anh/Chị.
Nhờ anh chị hỗ trợ xử lý chuỗi ký tự như file gửi kèm giúp ạ.
Cảm ơn anh chị.
View attachment 280981
Thực hiện theo trình tự các bước sau:Chào Anh/Chị.
Nhờ anh chị hỗ trợ xử lý chuỗi ký tự như file gửi kèm giúp ạ.
Cảm ơn anh chị.
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
Chào Anh/Chị.
Nhờ anh chị hỗ trợ xử lý chuỗi ký tự như file gửi kèm giúp ạ.
Cảm ơn anh chị.