在Excel中，如何编写循环，除非满足条件，否则会继续删除单元格的内容？

所以，我有三个非常大的数据列。 我希望这些匹配，但是在列之间有很多不匹配的行。

我想要做的是编写一个循环macros来删除单元格F2的内容，如果它们不等于A2或K2的内容。 但是，我只能find有关编写循环macros的详细信息。 是否有可能一遍又一遍地在同一个单元上执行一个命令？ 到目前为止我有：

 Sub ArrayMatch() Application.ScreenUpdating = True Dim F As Range For Each F In Range("F2:F2043").Cells F.Select If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0], [5]) Then Selection.Delete Shift:=xlUp Else: Stop End If Next 

目前，我只想让代码停止，如果其中任何一个是平等的。 但是，我有这里定义的范围的方式，代码只适用于该范围内的每个其他单元格。 我可以重新修改这个范围，让代码的其余部分重复应用到单元格F2吗？

谢谢！ 我会继续尝试我所热切期待的回应！

Answer 1

假设你的input：

我可以重新修改这个范围，让代码的其余部分重复应用到单元格F2吗？

这不正是你所期望的。 线索是你应该检查范围内的每个单元格，只有在不符合条件的情况下才移动到NEXT。 否则，该行被删除，并且应该保持在同一个位置，即不要向下移动，因为如果A1被移除，则A2现在变成A1 ，并且应该再次检查。

下面的代码将完成这项工作（也许你应该修改标准，但想法是这样）：

 Sub RemoveRows() Dim i As Long Dim ActiveCell As Range i = 2 Do While i <= 2043 Set ActiveCell = Range("F" & i) If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0], [5]) Then Selection.Delete Shift:=xlUp Else i = i + 1 End If Loop End Sub 

这是相当类似任务的示例： https : //www.dropbox.com/s/yp2cwphhhdn3l98/RemoweRows210.xlsm

Answer 2

尝试使用这样的东西：

 Sub checkF() RowCount = WorksheetFunction.CountA(Range("F2").EntireColumn) While RowCount >= 1 If Range("F2").Value = Range("A2").Value Or Range("F2").Value = Range("K2").Value Then Stop Else Range("F2").Delete Shift:=xlUp End If RowCount = RowCount - 1 Wend End Sub 

这将循环遍历，直到列F中剩下1个值，并且在任何值匹配时停止。

Answer 3

这是一个简单的循环，将执行以下操作：

1. 检索列A, F and K row 2所有单元格值
2. 检查F2的值是否等于A2或K2
   • 如果平等，什么也不做，退出macros观
   • 如果不相等，则删除F2值，向上移动单元格，检索新的F2值，然后从step 1开始

代码如下：

 Public Sub MatchFirstRow() Dim fCellValue As String Dim aCellValue As String Dim kCellValue As String Dim shouldCheckAgain As Boolean 'get values of each cell in question fCellValue = Cells(2, 6).Value aCellValue = Cells(2, 1).Value kCellValue = Cells(2, 11).Value shouldCheckAgain = True 'loop through while the cell in "F" has a value AND the previous value wasn't a match While Not IsEmpty(fCellValue) And Not fCellValue = "" And shouldCheckAgain shouldCheckAgain = False 'If row values don't match, delete cell in F, shift up, then 'reinitialize the F cell value for next pass If Not StrComp(fCellValue, aCellValue, vbTextCompare) _ And Not StrComp(fCellValue, kCellValue, vbTextCompare) Then Cells(2, 6).Select Selection.Delete Shift:=xlUp fCellValue = Cells(2, 6).Value shouldCheckAgain = True End If Wend End Sub 

只需将此代码粘贴到包含相关列的工作表的VB编辑器中即可。 例如，如果Sheet1具有列，则打开Visual Basic编辑器，双击Sheet1 ，然后将代码粘贴到那里。

一旦代码被粘贴，你可以通过selectMacrosbutton来运行这个常规的Macros 。

Answer 4

你应该这样做， 没有循环，要么

1. 插入使用=OR(F2=K2,F2=A2)的工作列以返回True或False结果，然后使用AutoFilter手动或使用vba删除False结果
2. 得到时髦，并直接在像下面这样的变体数组中执行（1），然后将变体数组转换回原始范围

码

 Sub GetEm() X = Filter(Application.Transpose(Application.Evaluate("=IF(--(F2:F2043=A2:A2043)+--(F2:F2043=K2:K2043),F2:F2043,""x"")")), "x", False) Range("F2:F2043").Value = vbNullString [f2].Resize(UBound(X), 1).Value = Application.Transpose(X) End Sub 

Answer 5

Worksheet_Change子应该在这里工作。 只要该工作表中的单元格发生更改，就会调用该子部分

 'This sub placed in one of the "Sheet1"/"Sheet2"/... objects in the list of 'Microsoft Excel Object in the VBA Editor will be called everytime you change 'a cell value in the corresponding sheet. '"Target" is the effected cell. Private Sub Worksheet_Change(ByVal Target As Range) 'Check that Target is cell F2 (6th column, 2nd row) If Target.Row = 2 And Target.Column = 6 Then 'If this is the cell we are looking for call the sub ValidateF2 ValidateF2 End If End Sub 

和：

 Sub ValidateF2() 'Check that the value of F2 is not equal to A2 or K2 If Not (Range("F2").Value = Range("A2").Value Or Range("K2").Value = Range("K2").Value) Then 'Set the value of F2 to "" (empty) Range("F2").Value = "" End If End Sub