如果单元格在A列中包含特定文本，则将单元格从C列复制到F列中堆叠

Question

我正在编写代码，其中 if in Column "A"="test" then 将单元格从 Col C 复制到 Col F 但不带空格。 有人可以帮忙吗？

Sub FindValuePaste()

    Dim FndRng As Range
    Dim cll As Range

    Set FndRng = Range("A3:A9")

    For Each cll In FndRng
        If cll.Value = "test" Then
           ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
            Range("F1").Offset(1) = cll.Offset(0, 2).Value
        End If
    Next cll

End sub

感谢您的帮助并提前感谢您！

Answer 1

从另一列复制匹配行

快速修复

Sub FindValuePaste()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim srg As Range: Set srg = ws.Range("A3:A9")
    Dim dcell As Range: Set dcell = ws.Range("F3")
    
    Dim scell As Range
    
    For Each scell In srg.Cells
        If StrComp(CStr(scell.Value), "test", vbTextCompare) = 0 Then
            dcell.Value = scell.Offset(, 2).Value
            Set dcell = dcell.Offset(1)
        End If
    Next scell
    
End Sub

Answer 2

• 使用

  .End(xlUp).Row

  定位最后一行

Sub FindValuePaste()
    Dim FndRng As Range
    Dim cll As Range
    Dim lastRow as Long, oSht as Worksheet
    Set oSht = ActiveSheet ' modify as needed
    lastRow = oSht.Cells(oSht.Rows.Count, "F").End(xlUp).Row 
    If len(oSht.Range("F" & lastRow)) > 0 Then  lastRow = lastRow + 1
    Set FndRng = oSht.Range("A3:A9")

    For Each cll In FndRng
        If cll.Value = "test" Then
           ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
            oSht.Range("F" & lastRow).Value = cll.Offset(0, 2).Value
            lastRow = lastRow + 1            
        End If
    Next cll
End sub

---

• 使用

  CountA

  获取非空白单元格的数量（数据应从 F 列的 F1 开始）

Sub FindValuePaste2()

    Dim FndRng As Range
    Dim cll As Range
    Dim lastRow As Long, oSht As Worksheet
    Set oSht = ActiveSheet ' modify as needed
    lastRow = Application.CountA(oSht.Columns("F")) + 1
    Set FndRng = oSht.Range("A3:A9")
    For Each cll In FndRng
        If cll.Value = "test" Then
           ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
            oSht.Range("F" & lastRow) = cll.Offset(0, 2).Value
            lastRow = lastRow + 1
        End If
    Next cll

End Sub

Answer 3

单元格 F3 中的公式怎么样：

=SUBSTITUTE(INDEX(FILTER(A3:C9,A3:A9="test"),0,3)," ","")

• FILTER 函数将表 A3:C9 过滤为仅包含“test”的行
• INDEX 函数从过滤范围中选择第 3 列
• 其中 SUBSTITUTE 替换空格（虽然我在示例表中没有看到必要性）