在VBA中select循环只select最后一行

我有一个工作表（＃1）包含对应于工作表＃2的行号列表。 在工作表＃2中需要select大约650行（在工作表＃2中共有11,000行）。

我做了这个小的VBA脚本

Sub SelectRows() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Set wb1 = Workbooks("worksheet1") Set wb2 = Workbooks("woorksheet2") Set ws1 = wb1.Sheets("Sheet1") Set ws2 = wb2.Sheets("Sheet2") For Each Row In ws1.Range("A1:A650").Cells ws2.Rows(Row).Select Next End Sub 

我遇到的问题是脚本运行后，它只会从工作表＃1中select最后一行＃。

所以如果工作表＃1看起来像这样…

1

6

100

…

5670

在运行我的程序后，我只能在工作表＃2上select行5670。

我怎么能告诉VBA，我想不断地添加到我的select，而不是只是重新select下一行？

编辑对于那些谁不清楚..

我有一个包含超过11000行数据的大型电子表格。 我需要从这个电子表格中select大约600行。 但是，我只知道我需要从这个电子表格中select的数据的行号。

所以，我创build了第二个电子表格，在A1：A600中列出了我需要在上述电子表格中select的行号。

是的，这是一个可怕的做事方式。 是的，如果还有其他的方式来select第＃行以外的数据，我会这样做。 简单地说，在我的情况下，没有。 如果你不相信我一整天都在试图解决这个问题的话，那很好，你可能会倒下这个问题。

Answer 1

如果您需要复制/粘贴每一行然后尝试在循环中随时进行。 这是一个可以适应的例子：

 Sub SelectRowsx() Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("Sheet2") Set ws3 = ThisWorkbook.Sheets("Sheet3") Dim cell Dim r As Integer For Each cell In ws1.Range("A1:A3").Cells ws2.Rows(2).EntireRow.Copy With ws3 r = .Cells(.Rows.Count, 1).End(xlUp).Row End With ws3.Range("A" & r).PasteSpecial xlPasteValues Next End Sub 

适应你的情况：

 Sub SelectRowsY() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim ws3 As Worksheet '<<new: the repository of the row copies Set wb1 = Workbooks("worksheet1") Set wb2 = Workbooks("woorksheet2") Set ws1 = wb1.Sheets("Sheet1") Set ws2 = wb2.Sheets("Sheet2") Set ws3 = wb1.Sheets("Sheet3") '<<new: the repository of the row copies Dim cell Dim r As Integer For Each cell In ws1.Range("A1:A650").Cells ws2.Rows(cell.Value).EntireRow.Copy With ws3 r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '<<find last empty row: the place the copy will be pasted End With ws3.Range("A" & r).PasteSpecial xlPasteValues Next End Sub 

似乎有可能通过Union方法在循环内build立一个由不同行组成的范围，然后这个范围可以复制/粘贴到不同的位置：

 Sub SelectRowsT() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet '<<new: the repository of the row copies Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") Set ws3 = Sheets("Sheet3") '<<new: the repository of the row copies Dim cell Dim r As Integer Dim rn As Range Dim selRange As Range For Each cell In ws1.Range("A1:A3").Cells Set rn = ws2.Rows(cell.Value).EntireRow If (selRange Is Nothing) Then Set selRange = rn Else Set selRange = Union(selRange, rn) End If Next selRange.Copy With ws3 r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '<<find last empty row: the place the copy will be pasted End With ws3.Range("A" & r).PasteSpecial xlPasteValues End Sub 

Answer 2

我将提出一个更有效的方法，即使用变体数组 。

策略如下：

• 设置工作表/工作簿对象（如迄今为止所做的那样）
• 将索引存储到Variant数组（名为vIndex ）
• 将内容存储到另一个Variant数组（名为vContent ）
• 将vContent粘贴到一个范围内

这里是代码：

 Sub CopyPaste() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim vIndex As Variant, vContent As Variant Dim lCounter As Long ' This is the workbook that contains the index range Set wb1 = ThisWorkbook ' Or whatever name Set wb2 = Workbooks("Other Sheet") Set ws1 = Sheet1 ' First sheet of Workbook2 - change accordingly Set ws2 = wb2.Sheets(1) ' Store index range to a variant array, for efficiency ' I used A2:A25 for my tests, change it to A1:A650 vIndex = ws1.Range("A2:A25").Value2 ' Initialize the array to be selected/copied ReDim vContent(1 To UBound(vIndex, 1)) ' Populate the content array, based on the rows shown by the index array For lCounter = 1 To UBound(vIndex, 1) vContent(lCounter) = ws2.Cells(vIndex(lCounter, 1), 1).EntireRow.Value2 Next lCounter ' Let's paste it next to another worksheet For lCounter = 1 To UBound(vIndex, 1) wb1.Sheets(2).Range("A" & lCounter).Resize(1, UBound(vContent(1), 2)).Value2 = vContent(lCounter) Next lCounter End Sub 

---

编辑

编辑复制所有行内容（尝试和testing）。

我强烈build议你不要复制整行，而是限制在你有数据的空间。

Answer 3

你将需要定义lastRow并添加一个新的表（ws3），但我希望这个逻辑是有道理的。 应该添加，我假设你想要的行是在A列。

 For i = 1 To LastRow 'r = row number wanted r = ws2.Cells(i, 1) 'drop into new sheet ws3.Rows(i) = ws1.Rows(r) Next i 

Answer 4

在你的代码的这些行中：

 For Each Row In ws1.Range("A1:A650").Cells ws2.Rows(Row).Select Next 

行是一个范围。 要获得行号，您需要Row.Row：

 For Each Row In ws1.Range("A1:A650").Cells ws2.Rows(Row.Row).Select Next 

如果您使用的是除Row以外的variables名，则可能会更容易看到：

 For Each c In ws1.Range("A1:A650").Cells ws2.Rows(c.Row).Select Next 

希望有所帮助