如何将基于条件逻辑的行复制并粘贴到某个起点并递增每次添加？

Question

我需要将动态范围的行复制并粘贴到同一工作簿中的硬编码位置。将根据条件逻辑复制一行。本质上，逻辑是，如果此特定单元格的值 = Law，则将该行和向右偏移 5 位的列粘贴到特定范围内。我运行遇到的问题是我的逻辑只是复制和粘贴一列并将其粘贴到指定范围内，但是，我的 For Each 循环中的每一行都会覆盖先前存在的值。此外，我的代码没有复制到第一列之外，当我也希望复制这些值时，第二列将被忽略。我需要将每个新添加的行粘贴到下一个空单元格中。以下是我目前正在使用的逻辑：

    Dim start_range As Range
    Set start_range = ws.Range("A2")
    Dim end_range As Range
    ws.Activate
    start_range.End(xlDown).Select
    Set end_range = ActiveCell
    Dim total_range As Range
    Set total_range = Range(start_range, end_range)
    For Each x In total_range
        If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
            x.Copy ws.Range("A10")
            x.Offset(5, 0).Copy ws.Range("B10")
            
        End If
    Next

所附图片的最上面的列显示了我将从中提取的数据源，底部显示了我希望根据清理代码看到的结果。如果需要进一步说明，请告诉我。

我之前尝试添加一个额外的 For Each 循环来获取我需要的第二列，但是，这似乎效率不高，而且我觉得事务可以在同一个 For Each 循环中完成，但是，我对如何实现这一目标感到困惑。

通过 Toddleson 更新了代码（仍然需要调整）

Dim wb As Workbook
Set wb = ThisWorkbook
Dim start_range As Range
Set start_range = wb.Sheets(1).Range("A2")
Dim end_range As Range
Set end_range = start_range.End(xlDown)
Dim total_range As Range
Set total_range = wb.Sheets(1).Range(start_range, end_range)
For Each x In total_range
    If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
        x.Copy wb.Sheets(1).Cells(10 + Count, 1)
        Count = Count + 1
        x.Offset(0, 5).Copy wb.Sheets(1).Cells(2, 10 + Count, 1)
        
    End If
Next

Answer 1

根据条件复制数据(`For Each...Next`)

Option Explicit

Sub CopyFilteredData()

    ' Workbook, Worksheet
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")

    ' Source

    ' Source Range (has headers)
    ' (the resize part means include only first 6 columns)
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion ' .Resize(, 6)
    ' Source Data Range (data without headers)
    Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)

    ' Destination

    ' Destination First Cell (the 3 means 4 rows below the last row)
    Dim dfCell As Range: Set dfCell = srg.Cells(1).Offset(srg.Rows.Count + 3)
    ' To copy to another worksheet instead you could e.g. do:
    'Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    'Dim dfCell As Range: Set dfCell = dws.Range("A2")
     
    ' Loop and copy.
    
    Dim rrg As Range ' Current Row (Range)

    ' Loop through the rows of the data range (no headers).
    For Each rrg In sdrg.Rows
        Select Case CStr(rrg.Cells(1).Value) ' 'CStr' also avoids errors
        Case "Law School Debt/Loan.", "Law" ' the comma means 'Or'
            rrg.Copy dfCell ' copy row and paste starting with 'dfCell'
            Set dfCell = dfCell.Offset(1) ' reference the (next) cell below
        End Select
    Next rrg

    ' Inform.

    MsgBox "Filtered data copied.", vbInformation

End Sub

Answer 2

您正在执行 Offset(5,0)，这会占用 x 下面 5 行的单元格。如果你想在 x 旁边获得 5 列，你需要 Offset(0,5)

如果您希望单元格不相互覆盖，则不能将“A10”和“B10”写入静态值。您需要添加一些计数器或变量，以便在粘贴值时移动地址。尝试将“A10”行更改为 x.Copy ws.Cells(10+Count, 1)，然后在复制粘贴后执行 Count = Count + 1。当然还要更改“B10”行。

Sub Example()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)
    
    Dim start_range As Range
    Set start_range = ws.Range("A2")
    
    Dim end_range As Range
    Set end_range = start_range.End(xlDown)
    
    Dim total_range As Range
    Set total_range = ws.Range(start_range, end_range)
    
    Dim Cell As Range, Count As Long
    For Each Cell In total_range.Cells
        If Cell.Value = "Law School Debt/Loan." Or Cell.Value = "Law" Then
            Cell.Copy ws.Cells(10 + Count, 1)
            Cell.Offset(0, 5).Copy ws.Cells(10 + Count, 2)
            Count = Count + 1
        End If
    Next
End Sub

如何将基于条件逻辑的行复制并粘贴到某个起点并递增每次添加？

How to copy and paste rows based on conditional logic to a certain start point and increment each addition?

excel

foreach

vba

根据条件复制数据(`For Each...Next`)

如何将基于条件逻辑的行复制并粘贴到某个起点并递增每次添加？

How to copy and paste rows based on conditional logic to a certain start point and increment each addition?

excel

foreach

vba

根据条件复制数据(For Each...Next)

根据条件复制数据(`For Each...Next`)