EXCEL-VBA 如何从范围中取消选择列？

Question

我写了一个宏来对我的表格进行排序并删除重复的行，如下所示：

Entitydocnum    Docstatus    Purchase-order   Created-date   Eyepeak
====================================================================== 
test1           pending          EL351-EE      27/03/2017       2
test2           pending          EL351-EE      06/04/2017       0
test1           pending          EL351-EE      30/03/2017       0
test4           pending          EL351-EE      25/03/2017       2

正如您所看到的，' test1 ' 行是重复的，因为 th Macro 认为它是不同的，因为日期是不一样的。 有一行 'test1' 是 30/03/2017，另一行是 27/03/2017

如何让我的宏忽略Created-date列（仅此列）以将 test1 (27/03/2017) 与 test1 (30/03/2017) 合并，后者采用更高的日期值..？

此时我的宏是：

（我的桌子从“B3”开始）

Sub thepcshop_macrotest()

ActiveSheet.Range("B3").Sort _
        Key1:=ActiveSheet.Columns("B"), _
        Header:=xlGuess
Do While Not IsEmpty(ActiveCell)                ' Tant que la cellule active n'est pas vide, recommence
    If ActiveCell = ActiveCell.Offset(-1, 0) Then   ' Condition : si la cellule active est identique
        ActiveCell.EntireRow.Delete                 ' ˆ la cellule prŽcŽdente (mme colonne), supprime
    Else: ActiveCell.Offset(1, 0).Select        'toute la ligne. Sinon, passe ˆ la cellule suivante.
    End If
Loop
MsgBox "Done :)"

End Sub

Answer 1

您可以将数据按日期降序排序，然后根据前三列删除重复项。

Sub thepcshop_macrotest()

    Dim rData As Range 'Whole data range
    Dim rDocNum As Range 'EntityDocNum range
    Dim rCreated As Range 'Created-date range


    With ThisWorkbook.Worksheets("Sheet1") 'Sheet name will need updating.
        'Reference required data ranges - many ways of doing this.
        'This method will work if there's nothing else on sheet.
        Set rData = .Range(.Cells(Rows.Count, 2).End(xlUp), .Cells(3, Columns.Count).End(xlToLeft))
        Set rDocNum = .Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp))
        Set rCreated = .Range(.Cells(4, 5), .Cells(Rows.Count, 5).End(xlUp))

        'Sort by DocNum ascending and Created date descending.
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=rDocNum, _
                             SortOn:=xlSortOnValues, _
                             Order:=xlAscending, _
                             DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=rCreated, _
                             SortOn:=xlSortOnValues, _
                             Order:=xlDescending, _
                             DataOption:=xlSortNormal
        With .Sort
            .SetRange rData
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        'Remove duplicates based on EntityDocNum, DocStatus and Purchase-order.
        rData.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

    End With
End Sub

Answer 2

检查此代码是否符合您的要求。

Sub thepcshop_macrotest()

    Dim Tmp As Variant

    ActiveSheet.Range("B3").Sort Key1:=ActiveSheet.Columns("B"), _
                                 Header:=xlGuess

    Do While Not IsEmpty(ActiveCell)                    ' Tant que la cellule active n'est pas vide, recommence
        With ActiveCell
            If .Value = .Offset(-1, 0).Value Then       ' Condition : si la cellule active est identique
                Tmp = .Offset(0, 3).Formula
                If Tmp <> .Offset(-1, 3).Value Then     ' i the previous is different
                    Tmp = Application.Max(Tmp, .Offset(-1, 3).Value)
                    ' replace the previous with the current if it is more recent
                    If Tmp < .Offset(-1, 3).Value Then .Offset(-1, 3).Value = Tmp
                End If
                .EntireRow.Delete                        ' ? la cellule pr?c?dente (mme colonne), supprime
            Else
                .Offset(1, 0).Select                    'toute la ligne. Sinon, passe ? la cellule suivante.
            End If
        End With
    Loop

    MsgBox "Done :)"
End Sub

通俗地说：如果所选单元格与上面的单元格具有相同的值，它会检查 D 列中的日期。如果当前行中的日期更近，则更改宝贵行中的日期。 无论此测试的结果如何，如果当前行在 A 列中的值与其上方的值相同，则该行将被删除。