根据可变范围内的多个条件删除和更改数据

Question

之前我问了一个类似的问题，有人帮我解决了这个宏的另一个问题，但现在我再次陷入困境（现在已经有一周了）。我想根据范围（行和列）制作宏变量。

为了更好地理解：

每周我都会添加最新的列并将其插入Q:R之间（仅在此示例中，它是变量）。这是我用来插入列的宏：

Sub insertColumn()

Dim lastrow         As Long
Dim LastCol         As Long

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
    lastrow = .Cells(.Rows.Count, "G").End(xlUp).Offset(7, 0).Row
    .Columns(LastCol - 2).Copy
    .Columns(LastCol - 1).Insert Shift:=xlToRight
End With

With Sheets("getDATA")
    .Range("G7").End(xlToRight).Offset(0, -2).Value = Date
    .Range(Cells(8, LastCol).Address(), Cells(lastrow, LastCol).Address()).Offset(0, -1).Formula = "=IFNA(INDEX($D:$D,MATCH($L8,$E:$E,0)),"""")"
End With

With Sheets("getDATA")
    .Columns(LastCol - 2).PasteSpecial Paste:=xlPasteValues
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

插入列后，我将检查DATA。如果添加了新内容，我将删除之前几周内的所有内容。

如果DATA具有相同的值一周，两周，三周或更多周，则宏应仅保留第一个。如果单元格为空，则宏应在“整体”列中添加“其他”。

整个列也应该显示值，我们保留。您可以在示例表中看到这一点 - 应该删除所有灰色的内容。

以下是检查标准的宏：

Public Sub CheckDATA()

    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

我认为主要问题出现在行中如果previousCell <> myCell Then previousCell.clear.该宏工作完美，直到我将添加第三周。主要的错误是它只检查它旁边的单元格而不是整个行范围。这将导致宏删除之前的每个值，无论值是连续3周相同。因此，我无法确定何时首先插入值 - 希望这确实有意义。每个“价值”都是销售订单块。我想知道该块首先出现在哪个星期

Answer 1

我会为每一行使用一个新的集合。您可以添加该值，并且您遇到错误（密钥已存在），然后清除您的单元格。最后，您可以使用最后输入的值来确定“整体”。请查看以下代码（我为测试定义了另一个范围，但您应该能够在代码中使用for..each以及之前的行）：

Sub Test()
Set myrow = Range("A1:H1")
    Dim Col As Collection, dmy
    On Error Resume Next
    Set Col = New Collection
    For Each mycell In myrow.Cells
        Err.Clear
        Col.Add mycell.Value, mycell.Value
        If Err Then mycell.ClearContents
    Next mycell
    myrow.Cells(1, myrow.Cells.Count + 1).Value = Col(Col.Count)
End Sub

编辑：如果您只想删除一个与最后一个值相同的值（而不是之前该行中的任何值，正如我所理解的那样），那么您不需要一个colletcion。只需使用常规变量，如下面的代码所示。我认为代码不会删除除...以外的其他值：

Sub Test2()
Dim CurVal$
Set myrow = Range("A1:H1")
    CurVal = ""
    For Each mycell In myrow.Cells
        If mycell.Value = CurVal Then
            mycell.ClearContents
        Else
            CurVal = mycell.Value
        End If
    Next mycell
    myrow.Cells(1, myrow.Cells.Count + 1).Value = iif(len(CurVal) > 0,curval,"other")
End Sub