Discussion :

[arnold95]

Bonjour à tous,
En fait j'ai un problème sous VBA j'ai réussi à le résoudre mais c'est un peu long je voudrais savoir si vous auriez une procédure plus rapide.
En fait j'ai sur la feuille un des données avec le critère département en colonne G. Sur une deuxieme feuille j'ai le critère département à retenir en colonne A. Ce que je souhaiterai c'est supprimer la ligne entière sur la feuille un si le département n'ést pas dans la liste des départements à retenir de la feuille 2. Merci beaucoup de votre aide et bonne journée.

[Jean-Philippe André]

salut arnold, peux-tu nous donner la méthode que tu utilises pour l'instant, qu'on puisse te donner des axes d'amélioration pertinents

[arnold95]

Pour l'instant c'est de la bidouille.lol.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Worksheets("feuil1").Select
For i = LignDepFeuil1 To LignFinFeuil1
Cells(i, 8).FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'Feuil1'!R1C1:R36C1,1,FALSE)"
Next i
 
 
For i = LignDepFeuil1 To LignFinFeuil1
Cells(i, 9).FormulaR1C1 = "=ISNA(RC[-1])"
Next i
 
For i = LignDepFeuil1 To LignFinFeuil1
Cells(i, 9).FormulaR1C1 = Trim(Cells(i, 9))
Next i
 
Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
 
 
derniereLigne = ActiveSheet.UsedRange.Rows.Count
'Application.ScreenUpdating = False
For r = derniereLigne To 1 Step -1
If (Range("I" & r)) = "Vrai" Then Rows(r).Delete
Next r

Voilà, en fait pour le moment je fais une fonction ISNA en étape intermédiare et si v'est vrai je retire la ligne entière.

[Jean-Philippe André]

d'accord, deja tu peux fusionner tes deux premières boucles for i. Le reste m'a l'air pas trop mal, mais je ne connais pas trop la partie selection...

[arnold95]

Oui les 2 premières je peux les fusionner mais j'aimerai supprimer l'étape ISNA

[arnold95]

Bonjour à tous.
Personne a une idée sur ma question?
Merci beaucoup

[Jean-Philippe André]

je pense pouvoir t'aider, mais peux-tu juste me donner le retour de la fonction isna stp ?

[arnold95]

Comment çà le retour de la fonction ISNA?

[Jean-Philippe André]

bon à l'arrache, comme je suppose que isna tourne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Worksheets("feuil1").Select
For i = LignDepFeuil1 To LignFinFeuil1
Cells(i, 8).FormulaR1C1 = _
"=VLOOKUP(RC[-1],'Feuil1'!R1C1:R36C1,1,FALSE)"
Next i
 
Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
 
 
derniereLigne = ActiveSheet.UsedRange.Rows.Count
'Application.ScreenUpdating = False
For r = derniereLigne To 1 Step -1
If (IsNa(Range("H" & r)) Then Rows(r).Delete
Next r

[arnold95]

Non mais çà ne marche pas...tu donnes pas de nom de variable ou de cellule a ISNA donc je vais changer çà et je vais essayé de voir si c'est plus rapide...merci

[AlainTech]

Testé avec la feuille de référence nommée Feuil2 et la feuille à traiter nommée Feuil1:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub SupprLignes()
  Dim wksRef As Worksheet
  Dim wksDest As Worksheet
  Dim rCel As Range
  Dim rFound As Range
  Dim i As Long
  Set wksDest = Sheets("Feuil1")
  Set wksRef = Sheets("Feuil2")
  For i = wksDest.Cells.SpecialCells(xlLastCell).Row To 1 Step -1
    Set rCel = wksDest.Cells(i, 7)
    If Not rCel.Text = "" Then
      Set rFound = wksRef.Columns(1).Find(rCel.Value)
      If rFound Is Nothing Then
        rCel.EntireRow.Delete
      End If
    End If
  Next i
End Sub