基於列值刪除行

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