根據列值刪除行

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

首先，代碼必須根據列標題（活動連接）狀態將所有行選擇為“否”，然后必須刪除行

我有更多的原始數據，包括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狀態將行選擇為“否”，然后將其刪除。

Answer 1

另一個版本比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

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方法的情況下，用於執行此操作的標准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

刪除很多行通常很慢。

此代碼針對大型數據進行了優化（基於刪除行優化解決方案）

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