如何遍历两列并选择行并添加到该行选择中？答案

【问题标题】：How do I loop through two columns and select rows and add to that selection of rows?如何遍历两列并选择行并添加到该行选择中？
【发布时间】：2016-04-30 14:48:12
【问题描述】：

我对 VBA 还很陌生。我目前正在尝试通过使用宏找到一种更快的方法来复制和粘贴信息。我不知道如何编码。

我有两列要与 For Each 循环一起使用。我想遍历这两列的每一行并使用 If 函数。如果第一行在 B 列中有值（B 列单元格 "" 或 B 列单元格 0），则选择该行（即 Range("A1:B1")）。

循环之后，我将复制所选内容并将其粘贴到特定行。但是，我想继续添加到该选择，因为它循环遍历每一行并且仅当它满足 If 条件时，所以我可以在最后将它全部复制一次。我该如何组合呢？

     A         B
   1 Abc       1
   2 Def       2
   3 Geh       3

【问题讨论】：

标签： vba excel

【解决方案1】：

这是扩展当前选择的方法：

Sub macro1()
Set selectedCells = Cells(1, 2)
Set selectedCells = Application.Union(selectedCells, Cells(2, 3))
selectedCells.Select
End Sub

我相信您可以自己管理其余代码，这真的很容易。您已经提到了您需要的一切：For Each cell In Range("B1:B5") 和 If 声明

【讨论】：

【解决方案2】：

请尝试以下代码

Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer

'Change the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1

' getting input from user
Set rng = Application.InputBox("Please select a range of cells!", "Please select a range", Selection.Address, , , , , 8)

    For Each one In rng
        If one.Value <> "" Or one.Value <> 0 Then
        Range(one.Offset(0, -1), one).Copy
        'Change the sheet and range name as yours
        Sheets("Sheet2").Activate
        Range("A" & i).Select
        ActiveSheet.Paste
        i = i + 1
        End If
    Next one
Application.ScreenUpdating = True
End Sub

上述宏将提示您输入要验证的范围并复制到 A 列中的 sheet2。

下面的代码将验证并将当前选定的范围复制粘贴到 sheet2 列 A

Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer

'Chnage the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1

' getting input from user
Set rng = Selection

    For Each one In rng
        If one.Value <> "" Or one.Value <> 0 Then
        Range(one.Offset(0, -1), one).Copy
        'Chnage the sheet and range name as yours
        Sheets("Sheet2").Activate
        Range("A" & i).Select
        ActiveSheet.Paste
        i = i + 1
        End If
    Next one
Application.ScreenUpdating = True

End Sub

【讨论】：

【解决方案3】：

我认为您可能以错误的方式处理此问题。您是否已经知道最终要将所有数据复制到哪里？听起来很像，因为您将其复制到“特定行”。如果是这样，您最好使用宏从 A:B 列中即时复制数据。

所以，例如：

Sub CopyData()

Const SOURCE_COLUMN1 As Long = 1 ' A
Const SOURCE_COLUMN2 As Long = 2 ' B
Const TARGET_COLUMN1 As Long = 5 ' E
Const TARGET_COLUMN2 As Long = 6 ' F

Dim lngSourceRow As Long
Dim lngTargetRow As Long

  With ThisWorkbook.Sheets("Sheet1")
    lngSourceRow = 1
    lngTargetRow = 0 ' Change this to the row above the one you want to copy to;
    Do While .Cells(lngSourceRow, SOURCE_COLUMN1) <> ""
      If .Cells(lngSourceRow, SOURCE_COLUMN2) <> "" Then
        lngTargetRow = lngTargetRow + 1
        .Cells(lngTargetRow, TARGET_COLUMN1) = .Cells(lngSourceRow, SOURCE_COLUMN1)
        .Cells(lngTargetRow, TARGET_COLUMN2) = .Cells(lngSourceRow, SOURCE_COLUMN2)
      End If
      lngSourceRow = lngSourceRow + 1
    Loop
  End With

End Sub

【讨论】：