Vba 根据列值删除行

我想知道如何在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（即“否”）删除那些没有activeconnect“否”的行

输出应如下所示

       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状态选择行为“否”，然后将其删除。

这是我第一次开始学习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

---

另一个版本比Matt的版本更通用

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

---

如果不包含至少一个基于的标准VBA编程框架，则用于执行此操作的标准VBA编程框架的集合将是不完整的

选项显式
Sub yes_电话（）
调暗iphn为长，phn_为字符串
错误转到bm_安全出口
appTGGL bTGGL:=假
phn_col=“科尔（电话号码）#”
带工作表（“表1”）
如果.AutoFilterMode，则.AutoFilterMode=False
带.Cells（1，1）.CurrentRegion
iphn=Application.Match（phn_col，.Rows（1），0）
.AutoFilter字段：=iphn，标准1:=是
使用.Resize（.Rows.Count-1、.Columns.Count）.Offset（1,0）
如果是CBool（Application.Subtotal（103.Cells）），则
.删除
如果结束
以
.AutoFilter字段：=iphn
以
如果.AutoFilterMode，则.AutoFilterMode=False
以
bm_安全出口：
appTGGL
端接头
子appTGGL（可选bTGGL为布尔值=真）
Application.ScreenUpdate=bTGGL
Application.EnableEvents=bTGGL
Application.DisplayAlerts=bTGGL
端接头

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

之前：

之后：

---

删除大量行通常非常缓慢

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

---

---

这可能是更好的答案。不过，出于某种原因，我发现我的语法更容易记住。可能是因为这对我来说更直观。我想是个人喜好，但我对这个答案投了赞成票。你必须注意VBA的默认行为是否区分大小写。电话列中的“否”或“否”值将不匹配。如果检查它是否是“是”可能会更好，就像检查

如果LCase（单元格（i，5）.Value2）“是”那么

。我猜这个方法比循环运行得快，但是我的天哪，谁能记住所有这些呢！：）瓦德，我可以。：）我花了大约7-8分钟来打字和测试。至少OP有不必从图像中键入的样本数据。您介意告诉我

CBool（Application.Subtotal（103.Cells））

是什么意思吗？上面的代码都不起作用。我不知道为什么。请你再检查一下好吗？这辆车有一个（3或103）。小计的计数从不包括隐藏的单元格。我发现这是一种方便的无损检查方法，可以查看是否有任何单元格/行要删除。

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

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