用于根据特定单元格条件将单元格从一列移动到另一列的 VBA 代码
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28349198/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA code for moving cells from one column to another based on specific cell criteria
提问by Anika Leena
I've seen several questions asking about moving cells from one workbook to another or one sheet to another using VBA, but I'm hoping to move information from one column to another in the same sheet based on specific criteria.
我见过几个问题，询问使用 VBA 将单元格从一个工作簿移动到另一个工作簿或一个工作簿到另一个工作簿，但我希望根据特定条件将信息从同一工作表中的一列移动到另一列。
I wrote this code to move cells from column A if they contained the word "save" to column I in the same sheet:
我编写了此代码以将 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
But, while this macro doesn't display any errors when I run it, it also doesn't seem to do much of anything else, either. Nothing is selected, cut, or pasted. Where in the code did I go wrong?
但是，虽然这个宏在我运行时没有显示任何错误，但它似乎也没有做任何其他事情。没有选择、剪切或粘贴任何内容。我在代码中哪里出错了？
采纳答案by Jason Faulkner
move cells from column A if they contained the word "save" to column I in the same sheet
将 A 列中包含“保存”一词的单元格移动到同一工作表中的 I 列
Your code doesn't do anything like this.
你的代码不会做这样的事情。
To accomplish what your requirements are, you would need something like this:
要完成您的要求，您需要这样的东西：
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
Edit
编辑
If you want to shift the entire contents of row over so it starts at column I, just replace the relevant section of code:
如果您想将 row 的全部内容移过来，使其从 column 开始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
回答by Gary's Student
Perhaps something like:
也许是这样的：
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
This code scans down the column, detects the matches and performs the copy. Copying brings over the formatas well as the value.
此代码向下扫描列，检测匹配项并执行复制。复制带来了格式和值。
回答by RAJA THEVAR
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
