Hỗ trợ tạo vòng lặp

[tiennam2705]

Gửi các anh các chị!
Em đang có 1 file khoán sản phẩm. Yêu cầu khoán mỗi nhân viên đều phải có hết danh sách sản phẩm như hình e gửi. Em gửi file cũ lên đây bác nào hỗ trợ e VBA hay hàm gì để ra được kiểu như file mới như hình e minh họa với ạ, chứ copy paste hơn 20k row chứ ko ít ạ. Hix. EM cảm ơn các bác nhiều

 

[Ba Tê]

Gửi các anh các chị!
Em đang có 1 file khoán sản phẩm. Yêu cầu khoán mỗi nhân viên đều phải có hết danh sách sản phẩm như hình e gửi. Em gửi file cũ lên đây bác nào hỗ trợ e VBA hay hàm gì để ra được kiểu như file mới như hình e minh họa với ạ, chứ copy paste hơn 20k row chứ ko ít ạ. Hix. EM cảm ơn các bác nhiều
View attachment 237990

Viết giúp bạn 1 Sub, tùy bạn sử dụng.

Option Explicit

Public Sub s_Gpe()
Dim Arr1(), Arr2(), dArr(), I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Txt As String
    Arr1 = Range("A2", Range("A2").End(xlDown)).Value2
    Arr2 = Range("B2", Range("B2").End(xlDown)).Value2
    R1 = UBound(Arr1):          R2 = UBound(Arr2)
ReDim dArr(1 To R1 * R2, 1 To 2)
For I = 1 To R1
    Txt = Arr1(I, 1)
    For J = 1 To R2
        K = K + 1
        dArr(K, 1) = Txt
        dArr(K, 2) = Arr2(J, 1)
    Next J
Next I
Range("G2").Resize(K, 2) = dArr
End Sub

 

[tiennam2705]

Viết giúp bạn 1 Sub, tùy bạn sử dụng.

Option Explicit

Public Sub s_Gpe()
Dim Arr1(), Arr2(), dArr(), I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Txt As String
    Arr1 = Range("A2", Range("A2").End(xlDown)).Value2
    Arr2 = Range("B2", Range("B2").End(xlDown)).Value2
    R1 = UBound(Arr1):          R2 = UBound(Arr2)
ReDim dArr(1 To R1 * R2, 1 To 2)
For I = 1 To R1
    Txt = Arr1(I, 1)
    For J = 1 To R2
        K = K + 1
        dArr(K, 1) = Txt
        dArr(K, 2) = Arr2(J, 1)
    Next J
Next I
Range("G2").Resize(K, 2) = dArr
End Sub

Ui chuẩn luôn bác ạ, thank bác nhiều nhiều