简体   繁体   中英

EXCEL-VBA How to un-select column from a Range?

I wrote a macro which sorted my table and deleted the duplicate row like that:

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

As you can see, the ' test1 ' row is duplicated because th Macro thinks it's different because of the date, which is not the same . There is one row 'test1' with 30/03/2017 and the other with 27/03/2017

How can I make my macro ignore the column Created-date (only this column) to merge test1 (27/03/2017) with test1 (30/03/2017).. which take the higher date value.. ?

At this moment my macro is:

(My table start at "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

You could sort your data into descending date order and then remove duplicates based on the first three columns.

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

Check if this code does what you want.

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

In plain language: if the selected cell has the same value as the one above it, it checks the date in column D. If the date in the current row is more recent the date in the precious row is changed. Whatever the outcome of this test, the current row is deleted if it has the same value in column A as the one above it.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM