VBA - Копировать, Вставить, затем перейти к следующему ряду, пока не достигнет пробелов

Question

По сути, у меня есть данные в трех столбцах и модель на отдельной вкладке. Вкладка данных содержит 1000 строк данных, и каждая запись будет проходить через модель, а результаты вставляются в четвертый столбец.

Вот как будет выглядеть одна итерация, но мне нужно, чтобы l oop через каждую строку.

Worksheets("Data").Range("E2:G2").Copy _ 
Worksheets("Model").Range("B4:D4").PasteSpecial Paste:=xlPasteValues

Calculate

Worksheets("Model").Range("C120").Copy_
Worksheets("Data").Range("H2").PasteSpecial Paste:=xlPasteValues

Worksheets("Model").Range("C121").Copy_
Worksheets("Data").Range("I2").PasteSpecial Paste:=xlPasteValues

Worksheets("Model").Range("C122").Copy_ 
Worksheets("Data").Range("J2").PasteSpecial Paste:=xlPasteValues

Затем мы скопируем следующий ряд данных с вкладки «Данные» (т. е. диапазон E3: G3).

Это похоже на сценарий classi c l oop, но я не знаю, как написать его в VBA.

Answer 1

Вы можете сделать это в диапазоне, я вижу два способа сделать это, используя копирование и вставку или просто реплицируя транспонированную версию данных:

'Copy and paste method
Worksheets("Model").Range("C120:C" & range("C" & rows.count).end(xlup).row).Copy 'Using the .end(xlup) will find the last row of data without looping until blank.
Worksheets("Data").Range("H2").PasteSpecial xlPasteValues,,,True 'The True here is what tells the pastespecial to transpose

'Transpose method
Worksheets("Data").Range("H2:J2").Value = application.transpose(Worksheets("Model").range("C120:C122"))

У каждого есть свои преимущества, Метод копирования и вставки проще, потому что вам не нужно знать конечный столбец, поэтому он легче работает для динамического диапазона c, метод транспонирования не использует буфер обмена, поэтому он меньше влияет на вашу систему.

Лучшим кодом метода был бы метод транспонирования.

Затем вы можете настроить простой For Next l oop для работы с любым количеством диапазонов данных.

Dim DataRow As Long, MyDat As Worksheet, MyModel As Worksheet
Set MyDat = Worksheets("Data")
Set MyModel = Worksheet("Model")
For DataRow = 2 To MyDat.Range("E" & Rows.Count).End(xlUp).Row
    MyModel.Range("B4:D4").Value = MyDat.Range("E" & DataRow & ":G" & DataRow).value
    Calculate
    MyDat.Range("H" & DataRow & ":J" & DataRow).Value = Application.Transpose(MyModel.Range("C120:C122"))
Next

Answer 2

Это простой l oop, который находит последнюю строку в «Data» и использует ее для l oop, определенного в «Model».

Ожидаемый результат этого заключается в том, что l oop начнется со строки 120 и продолжится до последней строки в «Данные», копируя данные из C120 в C (lRow) и вставляя их в лист «Данные».

Sub test()
    ' declare your variables so vba knows what it is working with
    Dim lRow, i As Long
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim srcws As Worksheet: Set srcws = wb.Worksheets("Data")
    Dim destws As Worksheet: Set destws = wb.Worksheets("Model")

    ' find the last row in Data
    lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row

    ' iterate from 120 to the last row found above
    For i = 120 To lRow
        ' copy /paste the data
        srcws.cells(1, 3).Copy Destination:=destws.cells(2, 7 + i)
    Next i
End Sub

Answer 3

Лучший способ - использовать функцию cell, где первый аргумент - это строка, а второй - столбец. Поскольку вы хотите указать источник для копирования из одной строки за раз, но при этом увеличить место назначения вставки на один столбец за раз, этот метод будет подходящим.

Кроме того, старайтесь не использовать "copy- вставить ", сосредоточиться на установке значения для ячейки, ссылаясь на атрибут значения из источника для копирования. Каждый раз, когда вы копируете, а затем вставляете в место назначения, вам понадобится дополнительная ячейка памяти, что приводит к гораздо более длительному затрачиваемому времени, если вы работаете с большим диапазоном для копирования.

Приведенный ниже код должен выполнять работу .

Sub CopyData()
    Dim i As Integer
    i = 8 ' Start pasting into column H
    ' Loop until a blank cell is found
    Do While Not Selection.Value = 0
        With Sheets("Data").Cells(i + 112, 3)
            ' Select each cell in "Data", starting on C120
            .Select
            ' Copy the value into "Model", starting on H2
            Sheets("Model").Cells(2, i).Value = .Value
        End With
    Loop
End Sub