VBA -复制、粘贴，然后移动到下一行，直到到达空格
实际上，我在三列中有数据，在单独的选项卡上有一个模型。data选项卡有1000行数据，每个条目都将通过模型运行，并将结果粘贴到第四列中。
下面是一次迭代的样子，但我需要它循环遍历每一行。
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然后，我们将从data选项卡中复制下一行数据(即范围E3:G3)。
这似乎是一个经典的循环场景，但我不知道如何用VBA编写它。
回答 3
Stack Overflow用户
发布于 2020-03-19 07:00:32
你可以在一个范围内做到这一点，我认为有两种方法可以做到这一点，使用复制和粘贴或简单地复制数据的转置版本：
'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"))每种方法都有自己的优点，复制和粘贴方法更容易，因为你不需要知道结束列，所以它更容易在动态范围内工作，转置方法不使用剪贴板，所以对系统的影响较小。
代码方面更好的方法是转置方法。
然后，您可以设置一个简单的For Next循环来遍历任意多个数据范围。
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"))
NextStack Overflow用户
发布于 2020-03-19 02:25:56
这是一个简单的循环，它找到"Data“中的最后一行，并将其用于"Model”中定义的循环。
这样做的预期结果是循环将从第120行开始，一直持续到" data“中的最后一行，将数据从C120复制到C(lRow)并将其粘贴到"Data”表中。
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 SubStack Overflow用户
发布于 2020-03-19 03:24:05
最好的方法是使用cells-function，其中第一个参数是行，第二个参数是列。由于您希望每次将要复制的源增加一行，而将粘贴目标每次增加一列，因此此方法将是合适的。
此外，尽量不要使用“复制-粘贴”，专注于通过引用要复制的源的值属性来设置单元格的值。每次复制然后粘贴到目标位置时，都需要一个额外的内存单元，如果要复制的范围很大，则会导致较长的运行时间。
下面的代码应该可以完成这项工作。
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 Subhttps://stackoverflow.com/questions/60745296
复制相似问题
腾讯云开发者
