em nhờ giúp đỡ code lấy dữ liệu theo thứ tự cụ thể sau ạ! (1 người xem)

[babe_nice]

Em chào Thầy, các anh, em nhờ giúp đỡ:
Lấy số liệu bên Sheet Dulieu sang Sheet Xep theo file đính kèm ạ.
Em cám ơn nhiêu nhiều !!

 

[Ba Tê]

Em chào Thầy, các anh, em nhờ giúp đỡ:
Lấy số liệu bên Sheet Dulieu sang Sheet Xep theo file đính kèm ạ.
Em cám ơn nhiêu nhiều !!

Chạy thử Sub dài thoòng này coi sao:

Public Sub GPE_()
Dim sArr(), dArr1(), dArr2(), tArr1(), tArr2(), J As Long, K1 As Long, K2 As Long
sArr = Sheets("Dulieu").Range("D3:D8").Resize(, 100).Value
ReDim dArr1(1 To UBound(sArr, 2) * 2, 1 To 1)
ReDim dArr2(1 To UBound(sArr, 2) * 2, 1 To 1)
ReDim tArr1(1 To UBound(sArr, 2), 1 To 1)
ReDim tArr2(1 To UBound(sArr, 2), 1 To 1)
For J = 1 To UBound(sArr, 2)
    If sArr(1, J) > 0 Then
        K1 = K1 + 1: K2 = K2 + 1
        dArr1(K1, 1) = sArr(6, J)
        dArr2(K1, 1) = sArr(1, J)
        tArr1(K2, 1) = sArr(6, J)
        tArr2(K2, 1) = sArr(2, J)
        K1 = K1 + 1
        dArr1(K1, 1) = sArr(6, J)
        dArr2(K1, 1) = sArr(4, J)
    End If
Next J
With Sheets("Xep")
    .Range("A3:A1000,BD3:BD1000").ClearContents
    .Range("A3").Resize(K1) = dArr1
    .Range("BD3").Resize(K1) = dArr2
    .Range("A3").Offset(K1 + 1).Resize(K2) = tArr1
    .Range("BD3").Offset(K1 + 1).Resize(K2) = tArr2
End With
End Sub

 

[babe_nice]

Chạy thử Sub dài thoòng này coi sao:

Public Sub GPE_()
Dim sArr(), dArr1(), dArr2(), tArr1(), tArr2(), J As Long, K1 As Long, K2 As Long
sArr = Sheets("Dulieu").Range("D3:D8").Resize(, 100).Value
ReDim dArr1(1 To UBound(sArr, 2) * 2, 1 To 1)
ReDim dArr2(1 To UBound(sArr, 2) * 2, 1 To 1)
ReDim tArr1(1 To UBound(sArr, 2), 1 To 1)
ReDim tArr2(1 To UBound(sArr, 2), 1 To 1)
For J = 1 To UBound(sArr, 2)
    If sArr(1, J) > 0 Then
        K1 = K1 + 1: K2 = K2 + 1
        dArr1(K1, 1) = sArr(6, J)
        dArr2(K1, 1) = sArr(1, J)
        tArr1(K2, 1) = sArr(6, J)
        tArr2(K2, 1) = sArr(2, J)
        K1 = K1 + 1
        dArr1(K1, 1) = sArr(6, J)
        dArr2(K1, 1) = sArr(4, J)
    End If
Next J
With Sheets("Xep")
    .Range("A3:A1000,BD3:BD1000").ClearContents
    .Range("A3").Resize(K1) = dArr1
    .Range("BD3").Resize(K1) = dArr2
    .Range("A3").Offset(K1 + 1).Resize(K2) = tArr1
    .Range("BD3").Offset(K1 + 1).Resize(K2) = tArr2
End With
End Sub

Em chào Thầy, Thầy dạo này khỏe không ạ?
Em cám ơn Thầy,...ham hố ở lại muộn để mò nhưng chưa ra,...may có Thầy giúp kịp, ...yên tâm về được rồi....
Nhưng sao lại dài thòong ạ? nếu Thầy còn viết ngắn hơn thì cho em xin. Còn em không có yêu cầu gì ngoài yêu cầu ban đầu ạ!

 

[Ba Tê]

Em chào Thầy, Thầy dạo này khỏe không ạ?
Em cám ơn Thầy,...ham hố ở lại muộn để mò nhưng chưa ra,...may có Thầy giúp kịp, ...yên tâm về được rồi....
Nhưng sao lại dài thòong ạ? nếu Thầy còn viết ngắn hơn thì cho em xin. Còn em không có yêu cầu gì ngoài yêu cầu ban đầu ạ!

Dài vì phải dùng 4 mảng kết quả. Lo xa "1 đống cột ẩn đi của bạn" không biết là cái gì trong đó, dùng 2 mảng thì tiêu luôn mỗi lần chạy code.

 

[babe_nice]

Dài vì phải dùng 4 mảng kết quả. Lo xa "1 đống cột ẩn đi của bạn" không biết là cái gì trong đó, dùng 2 mảng thì tiêu luôn mỗi lần chạy code.

Dạ, đúng rồi, 4 mảng lận, nhiều cột ẩn quá,...+_+...
em phải bố trí kiểu khác thôi, nếu em thu gọn về vùng A3:B ( như file đính kèm ạ) thì code sẽ chỉ dùng 1 mảng,...Vậy em mong Thầy chỉ dạy thêm code này ạ.