[英]Delete rows in Excel using VBA by finding column and value within column
我正在嘗試建立一個宏,該宏將找到標題為“ Total Labor”的列,並刪除該列中所有具有“ 0”的行。 我正在生成多個報告,“總勞力”列將更改位置,因此這就是我需要查找的原因。 到目前為止,我已經有了這段代碼,但是當我運行它時,什么都沒有發生。 任何幫助表示贊賞。
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Set FoundCell = rng.Find(what:="0")
Do Until FoundCell Is Nothing
FoundCell.EntireRow.Delete
Set FoundCell = rng.FindNext
Loop
End Sub
怎么樣:
Sub DeleteRow()
Dim colly As Long, killer As Range, nRow As Long
colly = 0
For i = 1 To Columns.Count
If Cells(1, i).Value = "Total Labor" Then
colly = i
Exit For
End If
Next i
If colly = 0 Then
MsgBox "Header not found"
Exit Sub
End If
nRow = Cells(Rows.Count, colly).End(xlUp).Row
For i = 1 To nRow
If Cells(i, colly).Value = 0 Then
If killer Is Nothing Then
Set killer = Cells(i, colly)
Else
Set killer = Union(killer, Cells(i, colly))
End If
End If
Next i
If killer Is Nothing Then
Else
killer.EntireRow.Delete
End If
End Sub
您需要復制Excel UI提供的FindAll
功能。 這是在VBA中實現此目標的代碼列表。 將其保存到.bas
文件,然后在找到'Total Labor'
后在宏中調用它,然后瀏覽從FindAll
返回的范圍並對其執行.Delete
。
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
If rng Is Nothing Then
Msgbox "Total Labor Not Found"
Else
Set SearchRange = rng.EntireColumn
FindWhat = "0"
Set FoundCells = FindAll(SearchRange:=SearchRange, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
If FoundCells Is Nothing Then
Debug.Print "Value Not Found"
Else
For Each FoundCell In FoundCells
FoundCell.EntireRow.Delete
Next FoundCell
End If
End If
End Sub
FindAll
源代碼 : http : FindAll
Function FindAll(SearchRange As Range, _
FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False, _
Optional BeginsWith As String = vbNullString, _
Optional EndsWith As String = vbNullString, _
Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
XLookAt = xlPart
Else
XLookAt = LookAt
End If
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
For Each Area In SearchRange.Areas
With Area
If .Cells(.Cells.Count).Row > MaxRow Then
MaxRow = .Cells(.Cells.Count).Row
End If
If .Cells(.Cells.Count).Column > MaxCol Then
MaxCol = .Cells(.Cells.Count).Column
End If
End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
after:=LastCell, _
LookIn:=LookIn, _
LookAt:=XLookAt, _
SearchOrder:=SearchOrder, _
MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FirstFound = FoundCell
Do Until False ' Loop forever. We'll "Exit Do" when necessary.
Include = False
If BeginsWith = vbNullString And EndsWith = vbNullString Then
Include = True
Else
If BeginsWith <> vbNullString Then
If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
If EndsWith <> vbNullString Then
If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
End If
If Include = True Then
If ResultRange Is Nothing Then
Set ResultRange = FoundCell
Else
Set ResultRange = Application.Union(ResultRange, FoundCell)
End If
End If
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
If (FoundCell Is Nothing) Then
Exit Do
End If
If (FoundCell.Address = FirstFound.Address) Then
Exit Do
End If
Loop
End If
Set FindAll = ResultRange
End Function
第一:如果設置Application.ScreenUpdating = False
,請確保在子結束之前將其重置為True
。 如果宏崩潰,您可能會發現自己無法使用該應用程序,直到重新啟動Excel或運行另一個設置Application.ScreenUpdating = True
宏。
現在,回答您的問題:代碼的問題在於,代碼中定義的rng
只會是包含“總勞力”的單元格。 當您在該范圍內搜索值“ 0”時, Set FoundCell = rng.Find(what:="0")
計算結果為“ Nothing”,因此,當您開始執行do循環時,它符合FoundCell Is Nothing
的條件FoundCell Is Nothing
,立即轉到End Sub
。
這樣的事情應該可以解決問題:
Sub DeleteRows2()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'~~>dim variables and set initial values
Dim rTotalLaborHeader As Range
Set rTotalLaborHeader = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Dim rTotalLaborColumn As Range
Set rTotalLaborColumn = Range(Cells(2, rTotalLaborHeader.Column), Cells(1048576, rTotalLaborHeader.Column).End(xlUp))
'Set rTotalLaborColumn = Range(rTotalLaborHeader.Offset(1, 0), rTotalLaborHeader.End(xlDown))
Dim rLaborRow As Range
'~~>Loop to delete rows with zero Total Labor
For Each rLaborRow In rTotalLaborColumn
If rLaborRow.Value = 0 Then rLaborRow.EntireRow.Delete
Next rLaborRow
CleanupAndExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Resume CleanupAndExit
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.