VBA 如果满足条件则复制并粘贴多个单元格

Question

如果满足条件，如何使用循环移动紧挨着它的单元格？说标准是 (Len=43) <- Acct#

Column#  |Date     |  Country   |  Acct#   |   Fruit     |   Price   |  Qty  
1        |11/02/16 |  India     |  5002xxx |   apple     |         |   5  
2        |12/02/16 |  5001xxx   |  Orange  |           |   10      |

我需要将第 2 列 acct# 移到它旁边的列之后的右列。如何将它与循环和 len 一起使用？什么是更好的方法？谢谢，干杯！

更新

 Sub Findandcut2()
    Dim row As Long

    For row = 2 To 1000

        If Range("M" & row).Value Like "*5027.1227000.0000.0000.000.0000.0000.0000*" Then

            Range("N" & row).Value = Range("M" & row).Value
            Range("M" & row).Value = ""
        End If
    Next

End Sub

所以在 M 列中是存储 Acct# 的位置，我必须抵消它旁边的以下单元格，但是使用上面的代码我只是删除值是 N 列和紧挨着的单元格到它不动。

Answer 1

您可能想要更改您的代码，例如（已评论）以下代码：

Sub Findandcut2()
    Dim cell As Range

    For Each cell In Range("M2", Cells(Rows.Count, "M").End(xlUp)) '<--| loop through all column "M" cell from row 2 down to last not empty row
        If cell.Value Like "*5027.1227000.0000.0000.000.0000.0000.0000*" Then
            With Range(cell, cell.End(xlToRight)) '<--| reference the range from current column M cell rightwards till the one preceeding first not empty one
                .Offset(, 1).Value = .Value '<--| copy values
            End With
            cell.ClearContents '<--| need to clear the cell you started offset values from?
        End If

    Next cell
End Sub

VBA 如果满足条件则复制并粘贴多个单元格

VBA to Copy and Paste Multiple Cells If Meet Criteria

excel

vba

loops

offset