在VBA中選擇循環僅選擇最后一行

Question

我有一個工作表（＃1），其中包含與工作表＃2相對應的行號列表。 我需要在工作表＃2中選擇大約650行（在工作表＃2中總共11,000ish行中）。

我盡可能地制作了這個小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數組（名為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

希望能有所幫助