Удалить строки на основе значения столбца

Question

Я хотел бы знать, как удалить строки на основе столбца в VBA?

Вот мой Ехчел

 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 «НЕТ».

Выход должен быть таким, как показано ниже.

 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

Коллекция Мэтта стандартных рамок программирования 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