基于列值删除行

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信使进口” 注：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

这是我第一次学习如何做，当我第一次开始学习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 2

另一个版本比马特的

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 3

A的执行该操作标准的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