将数据复制到循环中同一工作表中的偏移单元格答案

【问题标题】：Copy data to offset cell in same worksheet in a loop将数据复制到循环中同一工作表中的偏移单元格
【发布时间】：2023-01-02 02:52:05
【问题描述】：

我的目标是获取值并复制它并用一个额外的字符命名它。

例如，在我的 B 列中，我有名为 Example1 到 Example4 的值

我正在尝试将它们复制到 O Column 中所示的几个单元格中。我不能每次只复制并向下偏移四行，因为我的数据之间的行数不同。

我的目标是使用 C 列作为参考点来抵消它并收集信息。这可能不是最好的做法。

Sub Test()

    Dim addExample As String
    
    Set rngCC = Range("C1:C3000")
    
    addExample = "addEx"
    
    For Each cell In rngCC
    
        If cell = addExample Then
        
            ActiveCell.Select
            
            ActiveCell.Offset(0, -1).Select
            
            Selection.End(xlUp).Select
            
            Selection.Copy
            
            ActiveCell.Offset(0, 1).Select
            
            Cells.Find(What:="addEx", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            
            ActiveCell.Offset(0, -1).Select
            
            ActiveSheet.Paste
            
            ActiveCell.Select
            
            ActiveCell.Value = ActiveCell.Value & "b"
        
        End If
    
    Next

End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

这应该给你你需要的结果：

Sub Test()

    Dim r as Long, LastRow as Long
    With ActiveSheet
    
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        
        For r = 1 To LastRow
            If .Cells(r, "C") = "AddEx" Then
                .Cells(r, "B").Value = .Cells(r, "B").End(xlUp).Value & "b"
                .Cells(r, "B").End(xlUp).Value = .Cells(r, "B").End(xlUp).Value & "a"
                .Cells(r, "C").ClearContents
            End If
        Next
    
    End With
    
End Sub

【讨论】：