检查多个条件（如果更改则删除旧值，如果没有更改则删除新值）

起初，我试图写下多个If＆VLOOKUP公式，并通过VBA插入它们。 这导致我的电脑崩溃。 我必须检查servval条件/标准。 这里是示例表格：

灰色值是我想要删除的值。 示例中错误的date（应该是每周，而不是每天） 。

每个星期五，我想在今天的date之间在C ＆ D之间插入一个新的列（你可以在下面findmacros）。 然后macros应该检查插入的值。 如果macros插入一个不存在的新值，它应该把它删除，并在示例中删除列A到C的行中的所有内容（这是可变的，因为我将每周插入一个新列 – 它应该检查列A:[X] LastCol Offset -2 ）。 如果一个星期后macros显示相同的值，则只应保留最老的一个。 当价值进入时，这将让我们现在。 最后一步：在D列插入我们保留的值 – 这意味着范围A:[X] LastCol Offset -2的唯一值。 如果所有单元格中的输出都不是（ LastCol Offset -1 / A），则在D列（ LastCol Offset -1 ）中插入“Other”

目前这些列有一个INDEX(MATCH(())公式，这个公式将被复制到新的列中，被复制的列将只被特殊的粘贴（最后一步不在代码中，不是问题）。

 Sub insertColumn() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Copies the third last column and inserts it between the column [last date] and Overall' With Sheets("getDATA") Lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column .Columns(Lastcol - 2).Copy .Columns(Lastcol - 1).Insert Shift:=xlToRight End With With Sheets("getDATA") .Range("G7").End(xlToRight).Offset(0, -2).Value = Date End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

TL; DR：如果输出与之前的星期S相同，则只保留最早的值。 如果该值与之前的S周不同，则只保留新的值。 如果没有input，则在本例中的D列中写入“Other”（ LastCol Offset -1 ）。 如果它有一个值，将它插入D列

 Public Sub TestMe() Dim myRow As Range Dim myCell As Range Dim inputRange As Range Dim previousCell As Range Dim flagValue As Boolean Dim lastCell As Range Dim LastRow As Long Dim LastCol As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Sheets("getDATA") LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column End With Set inputRange = Worksheets(1).Range(Cells(8, 13).Address(), Cells(LastRow, LastCol - 2).Address()) For Each myRow In inputRange.Rows Set previousCell = Nothing flagValue = False For Each myCell In myRow.Cells If Len(myCell) Then flagValue = True If Not previousCell Is Nothing Then If previousCell <> myCell Then previousCell.clear Set previousCell = myCell Else myCell.clear End If Else Set previousCell = myCell End If Set lastCell = myCell Next myCell If Not flagValue Then lastCell.Offset(0, 1) = "Other" Else lastCell.Offset(0, 1) = previousCell End If Next myRow Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Answer 1

你需要两个嵌套的循环 – 一个通过行，一个通过单元格。 其余的是修理细胞，记住值和标志。 我没有清理牢房，而是用红色把它染成了红色。

要清除它，请将myCell.Font.Color = vbRed更改为myCell.clear 。

 Public Sub TestMe() Dim myRow As Range Dim myCell As Range Dim inputRange As Range Dim previousCell As Range Dim flagValue As Boolean Dim lastCell As Range Set inputRange = Worksheets(1).Range("A1:C4") inputRange.Font.Color = vbBlack For Each myRow In inputRange.Rows Set previousCell = Nothing flagValue = False For Each myCell In myRow.Cells If Len(myCell) Then flagValue = True If Not previousCell Is Nothing Then If previousCell <> myCell Then previousCell.Clear Set previousCell = myCell Else myCell.Font.Color = vbRed 'or myCell.clear to clear the value End If Else Set previousCell = myCell End If Set lastCell = myCell Next myCell If Not flagValue Then lastCell.Offset(0, 1) = "Other" Else lastCell.Offset(0, 1) = previousCell End If Next myRow End Sub 

input：

代码后：

关于识别inputRange 。 这实际上取决于你的范围如何以及从哪个行和列开始。 在一般情况下，如果从A1开始到最后一个使用的范围，可以这样设置范围：

 With Worksheets(1) Set inputRange = .Range(.Cells(1, 1), .Cells(LastUsedRow, LastUsedColumn)) End With 

LastUsedColumn和LastUsedRow 来自这里 。 如果你想消除两个左列，你可以简单地这样做：

 With Worksheets(1) Set inputRange = .Range(.Cells(1, 1), .Cells(LastUsedRow, LastUsedColumn-2)) End With