如何遍历两列并选择行并添加到选择的行?

时间:2016-01-24 07:18:05

标签: vba excel-vba excel

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

我想在For Each循环中使用两列。 我想循环遍历这两列的每一行并使用If函数。如果第一行在列B中具有值(列B单元格<>“或”列B单元格<> 0“),则选择该行(即,范围(”A1:B1“))。

在循环之后,我将复制所选的任何内容并将其粘贴到特定的行。 但是,我想继续添加该选择,因为它遍历每一行,并且只有当它满足If条件时,所以我能够在结束时将其全部复制一次。我如何组合这个?

     A         B
   1 Abc       1
   2 Def       2
   3 Geh       3

3 个答案:

答案 0 :(得分:0)

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

error.log

我确定您可以自己管理其余代码,这非常简单。您已经提到了所需的一切: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")声明

答案 1 :(得分:0)

请尝试以下代码

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

答案 2 :(得分:0)

我认为你可能会以错误的方式解决这个问题。您是否已经知道最终要将所有数据复制到哪里?这听起来像是,因为你指的是将它复制到一个特定的行&#34;。如果是这样,您最好使用宏来动态复制A列中的数据。

所以,例如:

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