XL 2010 Suppression de lignes sous conditions

[fouggy]

Bonjour le forum,

Mon double problème du jour, dont j'ai régler le premier, est le suivant :

* J'ai deux classeurs contenant plus de 600 feuilles.
* Dans les deux classeurs, la première feuille contient des lignes de données (+ de 12000) et l'ensemble de ces données a été copié dans les feuilles suivantes.
* Dans les deux classeurs, cette première feuille contient une colonne B contenant une codification RxCy où x et y vont de 1 à 9 (R1C1, R1C2, R3..., R9C1..., R2C1, R2C2, R2C3..., R2C9...,
Dans les deux classeurs la première feuille ne doit subir aucune modification.

PREMIERE PROBLEMATIQUE RESOLUE :

Dans le premier classeur, les feuilles se nomment R1, R2, R3, R4, ..., R12, R13..., R25..., R567..., R4579...
Ici on ne se préoccupe pas de la valeur y de la codification RxCy de la colonne B.
L'objectif est de supprimer dans toutes les feuilles, autres que la première, les lignes dont la valeur x n'est pas contenue dans le nom de la feuille.
Et donc dans la feuille R1 ne doivent se retrouver que les lignes dont la colonne B contient une codification de type R1Cy, dans la feuille R134 ne doivent se retrouver que les lignes dont la colonne B contient une codification de type R1Cy, ou R3Cy, ou R4Cy...

La macro suivante exécute parfaitement cette manip. :

Sub Occurences()

Application.ScreenUpdating = False
'
For f = 2 To Sheets.Count - 1
Sheets(f).Select
For i = Range("B1").End(xlDown).Row To 1 Step -1
agarder = False
For n = 1 To Len(ActiveSheet.Name) - 1
If "R" & Mid(ActiveSheet.Name, n + 1, 1) = Left(Cells(i, 2), 2) Then
agarder = True
End If
Next
If agarder = False Then
Rows(i).Delete
End If
Next
Next
'
Sheets(1).Select
Application.ScreenUpdating = True

MsgBox "OK"
'
End Sub


DEUXIEME PROBLEMATIQUE NON RESOLUE :

Dans le second classeur, les feuilles se nomment C1, C2, C3, C4, ..., C12, C13..., C25..., C567..., C4579...
Ici on ne se préoccupe pas de la valeur x de la codification RxCy de la colonne B.
L'objectif est de supprimer dans toutes les feuilles, autres que la première, les lignes dont la valeur y n'est pas contenue dans le nom de la feuille.
Et donc dans la feuille C1 ne doivent se retrouver que les lignes dont la colonne B contient une codification de type RxC1, dans la feuille R134 ne doivent se retrouver que les lignes dont la colonne B contient une codification de type RxC1, ou RxC3, ou RxC4...

Et là, la codification utilisée ne fonctionne pas et je n'arrive pas à trouver d'où cela vient :

Sub Occurences()

Application.ScreenUpdating = False

For i = Range("B1").End(xlDown).Row To 1 Step -1
agarder = False
For n = 1 To Len(ActiveSheet.Name) - 1
If "C" & Mid(ActiveSheet.Name, n + 1, 1) = Right(Cells(i, 2), 2) Then
agarder = True
End If
Next
If agarder = False Then
Rows(i).Delete
End If
Next

Sheets(1).Select
Application.ScreenUpdating = True

MsgBox "OK"
'
End Sub


Qui pourrait me dire où cela pêche ???

Merci de votre aide et de votre explication sur la modification proposée.

 

[zebanx]

Bonsoir Fouggy, le forum

Ton code a l'air de fonctionner (bon code avec mid/len).
J'ai rajouté la condition de feuilles (2 to sheets.count) mais après on est sur des modifications à la marge..
Ou je n'ai pas compris ta demande.

@+

 

[mapomme]

Bonsoir à tous,

Essayez :

Sub Occurences()
Dim wsh As Worksheet, derlig&, NumCSheet, i&

Application.ScreenUpdating = False
For Each wsh In ThisWorkbook.Worksheets
  If wsh.Index > 1 Then
    With wsh
      derlig = .Cells(Rows.Count, "b").End(xlUp).Row
      NumCSheet = Split(wsh.Name, "C", , vbTextCompare)(1)
      For i = derlig To 2 Step -1
        If InStr(1, NumCSheet, Right(.Cells(i, "b"), 1), vbTextCompare) = 0 Then .Rows(i).Delete
      Next
    End With
  End If
Next wsh
Sheets(1).Select
MsgBox "OK"
End Sub

edit 1 : bonsoir @zebanx 😉

edit 2 : corrigé noms des feuilles

Rem : un fichier test aurait été le bienvenu 😎

 

[zebanx]

Bonsoir @mapomme

Méthode plus rapide, bravo 😉
( une macro de plus à conserver)

Bonne soirée
zebanx

 

[mapomme]

Re,

Pour le fun, basée sur la ventilation des données source, voici une version:

• dont la feuille comprenant les données sources est "Feuil n°1"
• les feuilles où ventiler les données ont pour nom Cnnn où nnn est un nombre (à chiffres uniques) mais aucune vérification n'est faite sur le nom
• les feuilles où ventiler les données sont situées après la feuille "Feuil n°1"
• les feuilles résultats sont vidées avant la ventilation

rem : normalement bien plus rapide que la suppression ligne par ligne

 

[mapomme]

Re,

Une version v1d améliorée qui :

• vérifie que le nom de la feuille se termine par C999 (sinon on passe la feuille sans rien faire)
• élimine les chiffres en double au sein de 999
• avec une feuille "VERIF" de comptage Avant/Après (juste pour les tests)

 

[fouggy]

Yeeeeeppppppppppppp,

Elles fonctionnent toutes...

Un grand merci à vous