[英]EXCEL-VBA How to un-select column from a Range?
我寫了一個宏來對我的表格進行排序並刪除重復的行,如下所示:
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
您可以將數據按日期降序排序,然后根據前三列刪除重復項。
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
檢查此代碼是否符合您的要求。
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 列中的值與其上方的值相同,則該行將被刪除。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.