Option Explicit
Sub tach_dulieu()
Dim r As Long, c As Long, lastRow As Long, pos As Long, start As Long, end_ As Long, k As Long, curr_col As Long, max_col As Long
Dim text As String, prefix As String, dong, gioihan, dulieu(), kq()
With ThisWorkbook.Worksheets("Sheet1")
.Range("B2").Resize(100000, 1000).ClearContents ' xoa ket qua cu
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then Exit Sub ' khong co du lieu thi don do choi
dulieu = .Range("A2:A" & lastRow + 1).Value ' lay du 1 dong cuoi
End With
For r = 1 To UBound(dulieu, 1) - 1 ' khong xet dong lay du
prefix = ""
curr_col = 1 ' chiso cot hien hanh de nhap ket qua, khi bat dau dong moi thi = 1.
dong = Split(dulieu(r, 1), ",") ' tach du lieu trong moi dong cua cot A thanh mang gia tri theo dau phay
For c = LBound(dong) To UBound(dong) ' duyet tung thanh phan cua dong hien hanh
text = Trim(dong(c)) ' gia tri cua thanh phan hien hanh
If Len(text) Then
pos = InStr(1, text, ".") ' tim dau cham la ky tu ket thuc cua prefix vd. k02., 6x4.
If pos Then prefix = Mid(text, 1, pos) ' neu co dau cham thi xac dinh prefix hien hanh, neu khong co thi lay prefix cua thanh phan truoc do
If Len(prefix) Then ' de phong truong hop du lieu la vd. k0212-13 - khong co dau cham de xac dinh prefix hien hanh, khong co ca thanh phan truoc de lay prefix cua no
gioihan = Split(Mid(text, pos + 1), "-") ' gioi han co dang a hoac a-b
If IsNumeric(gioihan(0)) Then ' a phai la SO
start = CLng(gioihan(0)) ' gioi han dau
If UBound(gioihan) = 1 Then ' neu co gioi han cuoi tuc dang a-b
If IsNumeric(gioihan(1)) Then ' gioi han cuoi cung phai la SO
end_ = CLng(gioihan(1)) ' gioi han cuoi
End If
Else
end_ = start ' khi co dang a ma khong pha6i dang a-b
End If
If start <= end_ Then ' chi xet du lieu chuan khi gioi han dau <= gioi han cuoi
If max_col < curr_col + end_ - start Then ' neu so cot cua mang ket qua hien thoi < so cot can co thi mo rong them so cot
max_col = curr_col + end_ - start
ReDim Preserve kq(1 To UBound(dulieu, 1) - 1, 1 To max_col)
End If
For k = start To end_ ' nhap cac gia tri vao mang ket qua
kq(r, curr_col + k - start) = prefix & Format(k, "00")
Next k
curr_col = curr_col + end_ - start + 1 ' xac dinh vi tri nhap thanh phan tiep theo
End If
End If
End If
End If
Next c
Next r
ThisWorkbook.Worksheets("Sheet1").Range("B2").Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq ' dap ket qua xuong sheet
End Sub
