Скопируйте 7000 строк сначала в l oop, а затем в следующие 7000 строк, пока диапазон не станет пустым

Question

Мне нужен код, который должен сначала подсчитать, сколько раз должно быть выполнено l oop (предположим, у меня 18000 строк, затем 18000/7000 = 2,57, поэтому 3 раза), а затем он должен начать al oop и скопировать сначала 7000 строки и вставка в sheet2, а затем следующие 7000 строк (от 7001 до 14000), и это должно продолжаться до тех пор, пока диапазон не станет пустым.

Я имею в виду этот код, показанный здесь, но он не помогает мне:

Dim r As Long
Dim c As Long

c = GetTargetColumn() ' Or you could just set this manually, like: c = 1

With Sheet1 ' <-- You should always qualify a range with a sheet!

    For r = 1 To 7000 ' Or 1 To (Ubound(MyListOfStuff) + 1)

        ' Here we're looping over all the cells in rows 1 to 10, in Column "c"
        .Cells(r, c).Value = MyListOfStuff(r)

        '---- or ----

        '...to easily copy from one place to another (even with an offset of rows and columns)
        .Cells(r, c).Value = Sheet2.Cells(r + 3, 17).Value

    Next r

End With

Answer 1

"Это должно продолжаться, пока диапазон не будет пустым." Мой код ниже копирует весь диапазон, но не удаляет оригинал, как кажется из ваших описаний. Однако это должно быть довольно просто, если требуется - просто добавьте WsS.Cells.ClearContents в конце.

Тем временем код выполняет то, что вы описываете. Количество строк, которые нужно скопировать в одну l oop, можно задать в верхней части процедуры. Я установил Const BlockRowCount As Long = 3, делая 3 строки в al oop. Это также будет работать для 7000 строк.

Я заметил, что ваш код не копирует A1 в A1. Const FirstTargetCell As String = "B3" определяет верхнюю левую ячейку на листе назначения как B3. Вы можете указать любую ячейку в этом месте, и код будет зависать от данных этого колышка.

Sub TransferData()

    Const BlockRowCount As Long = 3
    ' cell A1 from the source sheet will arrive at
    ' FirstTargetCell on the target sheet. All other data relative to it.
    Const FirstTargetCell As String = "B3"      ' modify as required

    Dim WsS As Worksheet                ' Source sheet
    Dim WsT As Worksheet                ' Target sheet
    Dim Src As Range                    ' source data range
    Dim Tgt As Range                    ' target data range
    Dim Arr As Variant                  ' data array
    Dim Rl As Long, Cl As Long          ' last used row / column
    Dim Ct As Long                      ' first Target column
    Dim Rs As Long, Rt As Long          ' source / target row
    Dim R As Long

    Set WsS = Worksheets("Source Data")
    Set WsT = Worksheets("Destination")
    With Range(FirstTargetCell)
        Rt = .Row
        Ct = .Column
    End With

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    With WsS
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For Rs = 0 To Abs(Int(Rl / BlockRowCount * -1)) - 1
            R = Application.Min((Rs + 1) * BlockRowCount, Rl)
            Set Src = .Range(.Cells(Rs * BlockRowCount + 1, 1), _
                             .Cells(R, Cl))
            Arr = Src.Value
            With WsT
                Set Tgt = .Cells(Rt, Ct).Resize(UBound(Arr), UBound(Arr, 2))
                Tgt.Value = Arr
            End With
            Rt = Rt + BlockRowCount
        Next Rs
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub