Code chuyển mảng - sắp xếp dữ liệu theo điều kiện (1 người xem)

[hcm2015]

Chào các bạn GPE!

Các bạn giúp tôi đoạn code mảng chuyển đổi dữ liệu. (Xem file đính kèm.)
Từ bảng "Dữ liệu" sang bảng "Kết quả". Giống như tôi đã làm bằng tay.
Bảng kết quả tiêu đề từ I2:K2 là sẵn có. Kết quả dán vào I3:K3 trở đi


Dữ liệu được lấy căn cứ vào cột B tên. Mã đầu tiên độ dài = 6 ký tự (mã cha), tiếp theo là mã con, Mã con này có độ dài luôn luôn < 6 ký tự. Nên có thể dựa vào đó để nhận biết mã cha và mã con…
Căn cứ vào mã con mà bắt dữ liệu qua bảng kết quả. Nếu mã con 1 dòng thì bắt 1 dòng. Và cột Tên sẽ lấy mã cha. Nếu mã con có 2 dòng trở lên thì bắt 2 dòng….và thay thế 2 dòng mã con = mã cha… Cứ thế cho đến hết.


Trân trọng cảm ơn các bạn!

 

[Ba Tê]

Chào các bạn GPE!

Các bạn giúp tôi đoạn code mảng chuyển đổi dữ liệu. (Xem file đính kèm.)
Từ bảng "Dữ liệu" sang bảng "Kết quả". Giống như tôi đã làm bằng tay.
Bảng kết quả tiêu đề từ I2:K2 là sẵn có. Kết quả dán vào I3:K3 trở đi


Dữ liệu được lấy căn cứ vào cột B tên. Mã đầu tiên độ dài = 6 ký tự (mã cha), tiếp theo là mã con, Mã con này có độ dài luôn luôn < 6 ký tự. Nên có thể dựa vào đó để nhận biết mã cha và mã con…
Căn cứ vào mã con mà bắt dữ liệu qua bảng kết quả. Nếu mã con 1 dòng thì bắt 1 dòng. Và cột Tên sẽ lấy mã cha. Nếu mã con có 2 dòng trở lên thì bắt 2 dòng….và thay thế 2 dòng mã con = mã cha… Cứ thế cho đến hết.


Trân trọng cảm ơn các bạn!

Thử chạy code này coi sao

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Ten As String
sArr = Range("B3", Range("B3").End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    If Len(sArr(I, 1)) = 6 Then
        Ten = sArr(I, 1)
    Else
        K = K + 1
        dArr(K, 1) = Ten
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
    End If
Next I
Range("I3:K1000").ClearContents
Range("I3:K3").Resize(K) = dArr
End Sub

 

[hcm2015]

Thử chạy code này coi sao

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Ten As String
sArr = Range("B3", Range("B3").End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    If Len(sArr(I, 1)) = 6 Then
        Ten = sArr(I, 1)
    Else
        K = K + 1
        dArr(K, 1) = Ten
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
    End If
Next I
Range("I3:K1000").ClearContents
Range("I3:K3").Resize(K) = dArr
End Sub

Trân trọng cảm ơn anh rất nhiều. Code đã đúng ý em rồi!