根据列值删除行

Question

我想知道如何在 VBA 中根据列删除行？

这是我的excel文件

       A              B             C              D         E               F
     Fname          Lname         Email           city     Country     activeConnect
1     nikolaos       papagarigoui  np@rediff.com   athens   Greece         No
2     Alois          lobmeier      al@gmx.com      madrid   spain          No
3     sree           buddha        sb@gmx.com      Visakha  India          Yes

我想删除那些没有activeconnect“NO”的基于activeconnect（即“NO”）的行。

输出应该如下。

       A              B             C              D         E               F
      Fname          Lname         Email           city     Country     activeConnect
1     nikolaos       papagarigoui  np@rediff.com   athens   Greece         No
2     Alois          lobmeier      al@gmx.com      madrid   spain          No

首先，代码必须根据列标题（activeconnect）状态选择所有行为“否”，然后必须删除行

我有更多的原始数据，包括 15k 行和 26 列。当我们在 VBA 中执行时，代码必须自动运行。

工作表名称为“WX Messenger 导入” 注意：F1 是“activeConnect”的列标题

这是我的代码。

Sub import()
lastrow = cells(rows.count,1).end(xlUp).Row

sheets("WX Messenger import").select
range("F1").select

End sub

之后我无法根据列标题执行代码。有人可以告诉我。剩下的代码必须根据activeConnect状态选择行为“NO”，然后删除。

Answer 1

另一个比马特更通用的版本

Sub SpecialDelete()
    Dim i As Long
    For i = Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1
        If Cells(i, 5).Value2 = "No" Then
            Rows(i).Delete
        End If
    Next i
End Sub

Answer 2

这是我刚开始学习 vba 时学会的第一件事。我买了一本关于它的书，看到它是书中的一个直接例子（或者至少它是相似的）。我建议您购买一本书或查找在线教程。你会对你能完成的事情感到惊讶。我猜这是你的第一课。您可以在此工作表处于活动状态并被选中时运行它。我应该警告您，通常发布问题而没有任何证据表明您自己尝试解决问题，例如您自己的一些代码，可能会被否决。顺便说一句，欢迎使用 Stackoverflow。

'Give me the last row of data
finalRow = cells(65000, 1).end(xlup).row
'and loop from the first row to this last row, backwards, since you will
'be deleting rows and the loop will lose its spot otherwise
for i = finalRow to 2 step -1
    'if column E (5th column over) and row # i has "no" for phone number
    if cells(i, 5) = "No" then
        'delete the whole row
        cells(i, 1).entirerow.delete
    end if
'move to the next row
next i

Answer 3

如果不包括至少一个基于 AutoFilter Method 的标准 VBA 编程框架，则执行此操作的一组标准 VBA 编程框架将是不完整的。

Option Explicit

Sub yes_phone()
    Dim iphn As Long, phn_col As String

    On Error GoTo bm_Safe_Exit
    appTGGL bTGGL:=False

    phn_col = "ColE(phoneno)##"

    With Worksheets("Sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            iphn = Application.Match(phn_col, .Rows(1), 0)
            .AutoFilter field:=iphn, Criteria1:="<>yes"
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .Delete
                End If
            End With
            .AutoFilter field:=iphn
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

bm_Safe_Exit:
    appTGGL
End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
End Sub

您可能需要更正电话列的标题标签。我逐字记录了你的样本。批量操作通常比循环更快。

之前：

      

之后：

      

Answer 4

删除大量行通常很慢。

此代码针对大数据进行了优化（基于delete rows optimization解决方案）

Option Explicit

Sub deleteRowsWithBlanks()
    Dim oldWs As Worksheet, newWs As Worksheet, rowHeights() As Long
    Dim wsName As String, rng As Range, filterCol As Long, ur As Range

    Set oldWs = ActiveSheet
    wsName = oldWs.Name
    Set rng = oldWs.UsedRange

    FastWB True
    If rng.Rows.Count > 1 Then
        Set newWs = Sheets.Add(After:=oldWs)
        With rng
            .AutoFilter Field:=5, Criteria1:="Yes"    'Filter column E
            .Copy
        End With
        With newWs.Cells
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteAll
            .Cells(1, 1).Select
            .Cells(1, 1).Copy
        End With
        oldWs.Delete
        newWs.Name = wsName
    End If
    FastWB False
End Sub

---

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ActiveWorkbook.Sheets
            EnableWS ws, opt
        Next
    Else
        EnableWS ws, opt
    End If
End Sub
Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub