[英]Excel 2016 VBA Delete Rows with certain criteria
我有以下數據。
如果同一任務出現多於2行,則需要刪除第3、4,...重復行。 這些行已經按任務名稱和修改日期排序。 我只需要最新的數據和1個先前的數據(同一任務的前2行)。
在上圖中,應刪除第7、8、9、13、14、15、16、17 ...行
這並不像初看起來那樣容易。 每次我們循環行並根據某些條件刪除行時都會遇到問題。 我們刪除我們所在的行,然后移至下一行,但是由於我們刪除了我們所在的行,因此我們已經在下一行。 這就像在走路時從我們下面拉出地毯。
為了解決這些問題,我們通常向后退一步並刪除,但是...因為在這種情況下,我們僅基於已經找到的內容進行刪除,因此我們必須前進。
有幾種方法可以解決這個問題。 我認為最安全,最可靠的方法是循環一次以獲取每個術語的計數,然后再次循環並根據我們在第一個循環中發現的內容刪除相應數量的行。 這樣,我們可以控制要刪除的內容以及每次迭代的步幅。 它還降低了我們在跟蹤找到的內容,要刪除多少內容(如果需要刪除當前行)以及如何處理循環時將面臨的復雜性。
Sub removeRows()
Dim rngRow As Range
Dim dictTerms As Scripting.Dictionary
'Initialize Dictionary
Set dictTerms = New Scripting.Dictionary
'Load up dictionary using the term as the key and the count as the value
' by looping through each row that holds the terms
For Each rngRow In Sheet1.Rows("3:17")
'Only upsert to dictionary if we have a valule
If rngRow.Cells(1, 1).Value <> "" Then
If dictTerms.Exists(rngRow.Cells(1, 1).Value) Then
'increment value
dictTerms(rngRow.Cells(1, 1).Value) = dictTerms(rngRow.Cells(1, 1).Value) + 1
Else
'Add to dictionary with value 1
dictTerms.Add Key:=rngRow.Cells(1, 1).Value, Item:=1
End If
End If
Next rngRow
Dim intRow As Integer: intRow = 3
Dim intCounter As Integer
Dim termCount As Integer
'Loop through rows starting at intRow(set to 3 above) and ending at 17 (possible max)
Do While intCounter <= 17
'Skip blank rows
If Sheet1.Cells(intRow, 1).Value <> "" Then
'grab the number of terms encounterd so we know how much to delete
termCount = dictTerms(Sheet1.Cells(intRow, 1).Value)
'If it's more than two, then delete the remaining
If termCount > 2 Then Sheet1.Rows(intRow + 2 & ":" & intRow + termCount - 1).Delete
'Increment past what we deleted (or found if we didn't delete anything)
intRow = intRow + 2 + (termCount <> 1)
'Set the loop counter.
intCounter = intCounter + termCount
Else
'We found a blank, just increment our loop counter
intCounter = intCounter + 1
intRow = intRow + 1
End If
Loop
End Sub
您需要轉到工具>>參考,並添加Microsoft腳本運行時(在大列表中選中它旁邊的復選框,然后單擊確定),以便我們可以使用Scripting.Dictionary。
您還需要將對Sheet1的引用編輯到所使用的任何Sheet。 並且可能引用了Cells(1,1)
,將第一個1更改為我們正在分析的任何列(此處假定列為“ A”)。 最后,您需要調整startRow
和endRow
將這些值設置為適合您的工作簿的值。
@JNevill,當您提到每個任務的計數器時,我只是想到了一些簡單的方法,現在我只需要弄清楚如何刪除新列中值大於2的行...而不會出現錯誤腳本范圍或范圍類的刪除方法失敗
'Declare Variables
Dim tableName As String
Dim activeSheetName As String
Dim totalrows As Long
'Identify Active Sheet Name
activeSheetName = ActiveSheet.Name
'Identify Active Table Name
tableName = ActiveSheet.ListObjects(1).Name
'Identify total number of rows
totalrows = Worksheets(activeSheetName).Range(tableName).Rows.count '99
'Insert counter column
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim taskCounter As Long
Dim rowNum As Integer
rowNum = 2
taskCounter = 0
For a = 1 To totalrows + 1
If Range("A" & rowNum) = "" Then
taskCounter = 0
Range("B" & rowNum).Value = taskCounter
Else
taskCounter = taskCounter + 1
Range("B" & rowNum).Value = taskCounter
End If
rowNum = rowNum + 1
Next a
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.