Question

我有一个工作表（＃1），其中包含与工作表＃2对应的行号列表。我需要在工作表＃2中选择大约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中选择最后一行＃。

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

1

6

100

...

5670

我只能在运行程序后在工作表＃2上选择行5670.

如何告诉VBA我想继续添加到我的选择中而不是仅仅重新选择下一行？

修改的对于那些不清楚的人..

我有一个包含超过11,000行数据的大型电子表格。我需要从此电子表格中选择大约600行。但是，我只知道需要从此电子表格中选择的数据行数。

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

是的，这是一种可怕的做事方式。是的，如果有其他方式选择数据，那么排＃，我会这样做。简单地说，在我的情况下，没有。如果你不相信我一整天都试图解决这个问题，那很好，你可能会投票给这个问题。

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在循环内构建一个由不同行组成的范围 - 然后可以将此范围复制/粘贴到其他位置：

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 arrays。

策略如下：

设置工作表/工作簿对象（就像您目前所做的那样）
将索引存储到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

修改

编辑复制所有行内容（经过测试和测试）。

我强烈建议您不要复制整行，而应限制在您拥有数据的空间。

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以外的变量名称，则可能更容易看到：

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

希望有所帮助

在VBA中选择循环仅选择最后一行

4 个答案: