用于根据特定单元格条件将单元格从一列移动到另一列的 VBA 代码答案

【问题标题】：VBA code for moving cells from one column to another based on specific cell criteria用于根据特定单元格条件将单元格从一列移动到另一列的 VBA 代码
【发布时间】：2017-06-01 23:07:39
【问题描述】：

我看到几个问题询问有关使用 VBA 将单元格从一个工作簿移动到另一个工作簿或将一个工作表移动到另一个工作表，但我希望根据特定条件将信息从同一个工作表中的一列移动到另一列。

如果单元格包含“保存”一词，我编写此代码将单元格从 A 列移动到同一工作表中的 I 列：

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            cell.EntireRow.Cut
            Sheets("Jan BY").Range("I2").End(xlDown).Select
            ActiveSheet.Paste
        End If
    Next cell

End Sub

但是，虽然这个宏在我运行它时没有显示任何错误，但它似乎也没有做任何其他事情。没有选择、剪切或粘贴任何内容。代码哪里出错了？

【问题讨论】：

我很抱歉没有更具体，因为所有这些答案都非常好，并且完全符合我在问题中的要求。当我将单元格的内容从 A 列移动到 I 列时，我还需要将整行移过来。因此，例如，如果我在 A1 中有单词“save”，在 B1 中有数字 8，则 A1 和 B1 都需要移动，以便“save”现在在 I1 中，而 8 现在在 J1 中。我希望这是有道理的？这就是我包含“cell.EntireRow.cut”代码行的原因。

标签： vba excel range

【解决方案1】：

如果单元格包含“保存”一词，则将其从 A 列移至 I 列在同一张纸上

您的代码不会做这样的事情。

要完成您的要求，您需要这样的东西：

Sub Findandcut()
    Dim row As Long

    For row = 2 To 1000
        ' Check if "save" appears in the value anywhere.
        If Range("A" & row).Value Like "*save*" Then
            ' Copy the value and then blank the source.
            Range("I" & row).Value = Range("A" & row).Value
            Range("A" & row).Value = ""
        End If
    Next

End Sub

编辑

如果您想将行的全部内容转移到从列I 开始，只需替换相关的代码部分：

If Range("A" & row).Value Like "*save*" Then
    ' Shift the row so it starts at column I.
    Dim i As Integer
    For i = 1 To 8
        Range("A" & row).Insert Shift:=xlToRight
    Next
End If

【讨论】：

Jason，您的代码非常完美，它完全按照我的意愿移动了列。我完全忘记补充说，如果 A 列中的值包含“保存”，我需要将整行移到 I 列。因此，我需要剪切这些行并将它们移动到 7 列上，而不是消隐源。如果我可以修改您的代码以包含此更改，那将是完美的。抱歉没有更具体！
@AnikaLeena - 我不确定您所说的 如果 A 列中的值包含“保存”，我需要将整行移至 I 列。 是你说如果 A 包含“保存”，你想将行的全部内容转移到 7 个单元格上？
是的，例如，如果 A1 包含“save”而 B1 包含一个数字，则“save”将移至 I1，而 B1 中的数字将移至 J1。
谢谢，这太完美了！
@Jason 如果我想搜索所有列的值而不是仅搜索 A 列，您将如何将其实现到子

【解决方案2】：

可能是这样的：

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            cell.Copy cell.Offset(0, 8)
            cell.Clear
        End If
    Next cell

End Sub

此代码向下扫描列，检测匹配项并执行复制。复制带来了格式以及价值。

【讨论】：

【解决方案3】：

Sub Findandcut()
    Dim rngA As Range
    Dim cell As Range

    Set rngA = Sheets("Jan BY").Range("A2:A1000")
    For Each cell In rngA
        If cell.Value = "save" Then
            Sheets("Jan BY").Range("I" & Rows.Count).End(xlUp).Select
            Selection.Value = cell.Value
            cell.Delete Shift:=xlUp
        End If
    Next cell

End Sub

【讨论】：