dysfonctionnement macro

  • Initiateur de la discussion liloo23
  • Date de début
L

liloo23

Guest
Bonjour au forum,

Voila mon problème : lorsque j'inscrit un nombre en 'h14', le programme est censé supprimer certaines lignes suivant la valeur saisie.

Mais, par exemple, si cette valeur est égale à 14, le programme me supprime des lignes qu'il ne devrait pas.

J'ai pourtant vérifier mais je ne parviens à résoudre mon problème.

Merci par avance.

PS : J'espère que j'aurais réussi à être assez explicite ;) [file name=prog_20060526162159.zip size=3460]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prog_20060526162159.zip[/file]
 

Pièces jointes

  • prog_20060526162159.zip
    3.4 KB · Affichages: 19

CBernardT

XLDnaute Barbatruc
Bonjour liloo23 et re Pierrejean,

Même remarque. De plus il est bon de déclarer les variables.

Option Explicit
Sub Combinaisons_2()
Dim lettre As String, Ligne As Integer, Ws As Worksheet

If Range('b5') = 'x' Then

If Range('h14') <= 12 Then
lettre = 'PL7 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 12 Then
lettre = 'PL7'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 10 Then
lettre = 'PL6 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 10 Then
lettre = 'PL6'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 8 Then
lettre = 'PL5 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 8 Then
lettre = 'PL5'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 6 Then
lettre = 'PL4 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 6 Then
lettre = 'PL4'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 4 Then
lettre = 'PL3 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 4 Then
lettre = 'PL3'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 2 Then
lettre = 'PL2 B bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 2 Then
lettre = 'PL2 B'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 2 Then
lettre = 'PL2 A bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 2 Then
lettre = 'PL2 A'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 0 Then
lettre = 'PL1 bis'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If

If Range('h14') <= 0 Then
lettre = 'PL1'
For Ligne = 1 To [A65000].End(xlUp).Row
If UCase(Cells(Ligne, 1)) = UCase(lettre) Then
For Each Ws In Worksheets
Ws.Rows(Ligne).EntireRow.Delete
Next Ws
End If
Next Ligne
End If
End If
End Sub

Cordialement

Bernard
 
Bonjour lilo23, pierrejean, CbernardT

une erreur dans ce code, pour une suppression de ligne, on travaille en inverse pour ne pas modifier les références des lignes à tester.
dans ce code, si deux valeurs à supprimer se suivent, la deuxième ne sera pas supprimée
exemple ligne 9 & 10 contiennent des valeurs provoquant la suppression de ligne
quand la ligne 9 sera supprimée, la ligne 10 deviendra la ligne 9, la boucle passera à la ligne 10 ancienne ligne 11 et l'ancienne ligne 10 nouvelle ligne 9 ne sera pas testée
pour éviter cela, faire une boucle type
For Ligne = Range('A65536').End(xlUp).Row To 1 Step -1
comme cela les références modifiées auront déja été testées.

Cordialement, A+
 

Bebere

XLDnaute Barbatruc
bonjour Liloo,Pierre-Jean,Cbernard,Yeahou
je suis de l'avis de Yeahou
en plus dans quelle feuille commence t'il(peut être une feuille ou il n'y a rien à faire)
faire un tableau avec lettre moins de code à écrire(les blocs de code sont les mêmes)et ne vaut il pas mieux commencer les boucles sur les feuilles,tout ceci pour éclairer ma lanterne
à bientôt
 

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345