web-dev-qa-db-fra.com

Supprimer des lignes entières en fonction des valeurs de cellule

Je veux dans Excel (2003) prendre un dump de données importé et le formater dans un rapport. La plupart de ce que j'ai fait a consisté à enregistrer une macro puis à personnaliser le code si nécessaire. J'ai un endroit qui nécessite du code pur.

J'ai une colonne SORTED (D) qui répertorie les types d'incidents (par exemple: incendies de véhicules, accidents vasculaires cérébraux, morsures d'animaux, etc.). Je voudrais lire chaque valeur dans la colonne D et si ce n'est PAS l'une des valeurs que nous recherchons, supprimez la ligne entière.

J'ai essayé plusieurs versions de code (que j'ai trouvées en ligne) et le code qui produit les résultats les plus proches de ce dont j'ai besoin ressemble à ceci:

Range("D:D").Select
Dim workrange As Range
Dim cell As Range
Set workrange = Intersect(Selection, ActiveSheet.UsedRange)
For Each cell In workrange
    If ActiveCell.Value <> "VFIRE" _
        And ActiveCell.Value <> "ILBURN" _
        And ActiveCell.Value <> "SMOKEA" _
        And ActiveCell.Value <> "ST3" _
        And ActiveCell.Value <> "TA1PED" _
        And ActiveCell.Value <> "UN1" _
            Then ActiveCell.EntireRow.Delete
Next cell
End Sub

Ce code supprime la majorité de la liste (~ 100 lignes de l'original 168), mais il ne supprime que les lignes jusqu'à ce qu'il atteigne la première valeur de quelque chose que je veux. Par exemple, ce vidage de données actuel n'a aucune valeur pour "ILBURN" ou "SMOKEA", mais lorsque la première occurrence de "ST3" se produit, la macro s'arrête. Il n'y a pas d'erreur générée, il semble juste penser que c'est fait. 

Que dois-je ajouter pour appeler la macro dans toute la liste? 

vbaexcel-2003
5
user3613124

Je suis tout sur la brièveté.

Sub DeleteRowBasedOnCriteria()
Dim RowToTest As Long

For RowToTest = Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1

With Cells(RowToTest, 4)
    If .Value <> "VFIRE" _
    And .Value <> "ILBURN" _
    And .Value <> "SMOKEA" _
    And .Value <> "ST3" _
    And .Value <> "TA1PED" _
    And .Value <> "UN1" _
    Then _
    Rows(RowToTest).EntireRow.Delete
End With

Next RowToTest

End Sub
5
tbur

Je suis d'accord avec @ Tim_Williams sur le fait que vous devez travailler en arrière, car cela semble être le problème. Je ferais quelque chose comme ça.

Sub Main()
Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer

'Find first and last used row in column D
Range("D:D").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
    Set workrange = Cells(lrow, 4)
    If workrange.Value <> "VFIRE" _
        And workrange.Value <> "ILBURN" _
        And workrange.Value <> "SMOKEA" _
        And workrange.Value <> "ST3" _
        And workrange.Value <> "TA1PED" _
        And workrange.Value <> "UN1" _
            Then workrange.EntireRow.Delete

Next lrow

End Sub
0
Adach1979

Je l'ai utilisé dans l'une de mes tâches, où j'avais un tableau de données de test de 100 itérations que je souhaitais ajuster à la première itération de 10, donc j'ai utilisé les cellules "itération #> 10" pour supprimer la ligne entière.

Sub trim_row()

' trim_row Macro
' to trim row which is greater than iteration#10

Dim RowToTest As Long
Dim temp As String
Dim temp1 As Integer

For RowToTest = Cells(Rows.Count, 6).End(xlUp).Row To 2 Step -1

With Cells(RowToTest, 6)

temp = .Value
If temp = "" Then

    Else
    temp1 = Trim(Replace(temp, "Iteration# :: ", ""))

        If temp1 > 10 Then
        Rows(RowToTest).EntireRow.Delete
        End If
End If

End With

Next RowToTest

End Sub

Je utilisateur remplace & trip pour extraire le nombre de la chaîne et introduit la condition if = "" pour ignorer les lignes vides. J'avais une ligne vide séparant à l'ensemble de données de test. 

0
mdkarthikeyan