Question

起初，我试图写下多个If＆amp; VLOOKUP公式并通过VBA插入它们。这导致我的计算机崩溃。我必须检查serval条件/标准。以下是示例表：

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

每个星期五，我想在C＆amp;之间插入一个新列。 D与今天的日期（你可以进一步找到宏。它的工作原理）。然后宏应检查插入的值。如果宏之前插入了一个之前没有的新值，它应该接受并删除示例中A列到C行中的其他所有内容（这是变量，因为我和＃39;每周会插入一个新列 - 它应该检查列A:[X] LastCol Offset -2）。如果宏在一周之后输出相同的值，它应该只保留最旧的值。当输入值时，这将让我们现在。最后一步：在D列中插入我们保留的值 - 这意味着A:[X] LastCol Offset -2范围内的唯一值。如果所有单元格中的输出都不是（#N / A），则插入＆＃34;其他＆＃34;在D栏（LastCol Offset -1）

中

目前这些列的公式为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 周不同，则仅保留新值。如果没有输入任何内容，请写下＃34;其他＆＃34;在此示例中的D列中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

输入：

代码之后：

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

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

LastUsedColumn和LastUsedRow are from here。如果你想删除两个左列，你可以这样做：

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

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

1 个答案: