[Xin giúp đỡ] VBA copy dữ liệu lặp như file đính kèm (1 người xem)

[bienda]

Tình hình là em viết 1 đoạn code để copy dữ liệu lặp (trong ví dụ của em là lặp 4 lần)
Em chưa biết phải xử lí như nào để nó copy lặp lại, mong các bác chỉ giáo
Em xin cám ơn nhiều

Sub checking()
    
    Dim bang As Range
    Dim m, i, j As Integer
    Do Until Sheets("Support").Cells(m + 1, 1) = ""
        m = m + 1
    Loop
    Set bang = Sheets("Support").Range("A2:I" & m)
    For j = 0 To 4
        For i = 1 To (m - 1) * j
            Range("C" & i + 42) = bang(i, 3)
            Range("A" & i + 42) = i
        Next
    Next j
End Sub

 

[Ba Tê]

Tình hình là em viết 1 đoạn code để copy dữ liệu lặp (trong ví dụ của em là lặp 4 lần)
Em chưa biết phải xử lí như nào để nó copy lặp lại, mong các bác chỉ giáo
Em xin cám ơn nhiều

Sub checking()
    
    Dim bang As Range
    Dim m, i, j As Integer
    Do Until Sheets("Support").Cells(m + 1, 1) = ""
        m = m + 1
    Loop
    Set bang = Sheets("Support").Range("A2:I" & m)
    For j = 0 To 4
        For i = 1 To (m - 1) * j
            Range("C" & i + 42) = bang(i, 3)
            Range("A" & i + 42) = i
        Next
    Next j
End Sub

Muốn Copy lặp lại thì bạn xem tạm cách này:

Sub checking()
Dim Bang As Range
Dim I As Long, J As Long, K As Long, N As Long
Set Bang = Sheets("Support").Range("C2", Sheets("Support").Range("C2").End(xlDown))
N = 4       '<----------So lan lap'
K = 43:     J = Bang.Rows.Count
For I = 1 To 4
    Bang.Copy Sheets("Load").Range("C" & K)
    K = K + J
Next I
For I = 1 To J * N
    Sheets("Load").Range("A" & 42 + I) = I
Next I
Set Bang = Nothing
End Sub

Muốn dùng mảng để gán 1 lần thì coi thử cái này:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long
N = 4           '<-----------4 lan'
With Sheets("Support")
    sArr = .Range("C2", .Range("C2").End(xlDown)).Value
End With
ReDim dArr(1 To UBound(sArr) * N, 1 To 3)
For J = 1 To N
    For I = 1 To UBound(sArr)
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 3) = sArr(I, 1)
    Next I
Next J
Sheets("Load").Range("A43").Resize(K, 3) = dArr
End Sub

 

[bienda]

Ôi, bá đạo quá, em cảm ơn nhiều, code của bác chạy nhanh khủng khiếp
Nhân tiệp bác cho em hỏi cột B ở Sheet("Load")
em muốn nó lặp giáp trị B43:B50 = 1, B51:B58 = 2, B59:B66 =3, tương tự bằng 4,5,6 tùy vào vòng lặp thì code phải như thế nào ạ, Em đội ơn bác

 

[Ba Tê]

Ôi, bá đạo quá, em cảm ơn nhiều, code của bác chạy nhanh khủng khiếp
Nhân tiệp bác cho em hỏi cột B ở Sheet("Load")
em muốn nó lặp giáp trị B43:B50 = 1, B51:B58 = 2, B59:B66 =3, tương tự bằng 4,5,6 tùy vào vòng lặp thì code phải như thế nào ạ, Em đội ơn bác

Thêm 1 dòng lệnh nữa thôi.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long
    N = 4           '<-----------4 lan'
    sArr = Sheets("Support").Range("C2", Sheets("Support").Range("C2").End(xlDown)).Value
    ReDim dArr(1 To UBound(sArr) * N, 1 To 3)
For J = 1 To N
    For I = 1 To UBound(sArr)
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = J
        dArr(K, 3) = sArr(I, 1)
    Next I
Next J
    Sheets("Load").Range("A43").Resize(K, 3) = dArr
End Sub

 

[bienda]

Em hỏi thêm 1 cấu nữa bác đừng bực em ạ, vì em quên mất
Em muốn sửa mảng sArr lấy rộng dữ liệu từ cột A đến cột I bên sheet"Support" để em copy thêm dữ liệu lặp lại sang bên sheet Load thì em phải làm sao ạ? em chỉ còn biết cách thêm 1 mảng sArr nữa mới làm được

 

[Ba Tê]

Em hỏi thêm 1 cấu nữa bác đừng bực em ạ, vì em quên mất
Em muốn sửa mảng sArr lấy rộng dữ liệu từ cột A đến cột I bên sheet"Support" để em copy thêm dữ liệu lặp lại sang bên sheet Load thì em phải làm sao ạ? em chỉ còn biết cách thêm 1 mảng sArr nữa mới làm được

Tính từ cột C đến cột I sheet "Support" thôi , cột A và B chẳng liên quan với kết quả.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, Col As Long, Lubu As Long
N = 4           '<-----------4 lan'
Col = 7         'So Cot tinh tu cot C den cot I'
With Sheets("Support")
    sArr = .Range("C2", .Range("C2").End(xlDown)).Resize(, Col).Value
End With
ReDim dArr(1 To UBound(sArr) * N, 1 To Col + 2)
For J = 1 To N
    For I = 1 To UBound(sArr)
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = J
        For Lubu = 1 To Col
            dArr(K, Lubu + 2) = sArr(I, Lubu)
        Next Lubu
    Next I
Next J
Sheets("Load").Range("A43").Resize(K, Col + 2) = dArr
End Sub

Chuyện của mình mà sao "bị" quên nhỉ???

 

[bienda]

Chuyện của mình mà sao "bị" quên nhỉ???

Đãng trí lắm bác ạ, em loay hoay mãi, may mà có bác
Em cảm ơn rất nhiều
Có gì vướng mắc lại mong ngóng sự giúp đỡ của bác