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的行（即＆＃34; NO＆＃34;）那些没有主动连接的行＆＃34; NO＆＃34;。

输出应如下所示。

       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）状态选择所有行为＆＃34;否＆＃34;然后它必须删除行

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

工作表名称是＆＃34; WX Messenger导入＆＃34; 注意：F1是列标题，即＃34; activeConnect＆＃34;

这是我的代码。

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

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

End sub

之后我无法根据列标题执行代码。有人可以让我知道。其余代码必须根据activeConnect状态选择行为＆＃34;否＆＃34;然后删除它。

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

用于执行此操作的标准VBA编程框架集合将不完整，但不包括至少一个基于AutoFilter Method的内容。

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

根据列值删除行

4 个答案: