Afficher les cellules filtrées
Bonjour à tous les passionnés d'Excel VBA (2007),
Sur un fichier d'adhérents, j'ai une routine qui cherche les doublons et devrait les afficher.
Pour l'instant :
mon écran est fractionné,
les volets sont figés,
le formatage des cellules est opérationnel sur 300 lignes (couleurs de fond, taille de la police, formules de calcul etc...)
seules 40 lignes sont occupées par des données pour roder le système
Lorsque j'appelle la recherche des doublons, ma routine les trouve sans problème, mais je souhaiterais qu'ils restent visibles soit pour en conserver un ou plusieurs, en cas d'homonymie par exemple, soit pour en effacer un ou plusieurs s'il s'agissait effectivement de doublon(s). Or, le résultat de mon tri disparaît, il n'est pas visible, la première ligne affichée sous la ligne des entêtes de colonnes est la ligne 301.
Je n'arrive pas à identifier ce qui "cloche" dans le code ci dessous :
'Affichage des doublons
Application.ScreenUpdating = False
RepAffichage = MsgBox("Voulez-vous afficher les doublons ?", vbYesNo + vbQuestion, "Affichage des doublons")
If RepAffichage = vbNo Then Exit Sub
LE1 = Range("D65536").End(xlUp).Row
'MsgBox LE1
Rows("13:13").Select
Range("D12").Activate
ActiveSheet.Range("D14:P" & LE1).Select
Selection.AutoFilter
ActiveSheet.Range("D14:P" & LE1).AutoFilter Field:=1, Criteria1:="3"
Selection.SpecialCells(xlCellTypeVisible).Select
Application.ScreenUpdating = True
Range("D12").Select
End Sub
Par avance, merci de votre aide.
Boucoiran
Bonjour
BOUCOIRAN a écrit :ma routine les trouve sans problème
BOUCOIRAN a écrit :Or, le résultat de mon tri disparaît, il n'est pas visible
Une contradiction que je ne comprends pas
Ton fichier avec des données bidons mais exploitables serait utile ainsi qu'un exemple de ce que tu obtiens
Bonsoir à tous,
Encore une fois, c'est Banzai64 qui m'a dépanné. Merci à lui et à tous ceux qui ont tenté de solutionner mon problème et qui n'y sont pas arrivés.
Boucoiran
Bonjour à tous les aficionados du forum Excel pratique,
Hier en fin d'après midi j'ai indiqué que mon problème était résolu. En fait c'est Banzai64 qui m'a ouvert les yeux en insistant sur le fait que les versions antérieures à 2007 ne permettent pas de filtrer des cellules en fonction de leur couleur. Mon application devant être utilisé par des membres de l'association à laquelle j'adhère se trouvent dans ce cas. J'ai donc été contraint de contourner l'obstacle et je vous livre ci-après le fruit de ce travail. A savoir que cette routine est complétée par une autre qui vient ensuite permettre d'effacer les doublons et de restaurer le fichier dans son aspect antérieur, mais sans doublon(s).
'Variables pour Tri sur le NOM
choix = 1 'pour que les cellules doublonnes présentent une couleur de fond rouge
choix2 = "e" 'pour indiquer la colonne sur laquelle sera effectué le tri
'Neutralisation du rafraichissement de l'Ecran
Application.ScreenUpdating = False
test = Timer
der_ligne = Range(choix2 & "65536").End(xlUp).Row
Dim tab_cells()
ReDim tab_cells(der_ligne - 1)
For ligne = 1 To der_ligne
tab_cells(ligne - 1) = Range(choix2 & ligne)
Next
For ligne = 1 To der_ligne
contenu = tab_cells(ligne - 1)
'Colorier en Rouge les doublons de toutes les cellules trouvées
If choix = 1 And contenu <> "" Then 'Colorier les doublons
For i = 1 To der_ligne
If contenu = tab_cells(i - 1) And ligne <> i Then 'Si doublon
nb = nb + 1
NBCR = nb
If choix = 1 Then
Range(choix2 & ligne).Interior.ColorIndex = 3
CR = Range("E" & i).Value
End If
Exit For
End If
Next
End If
Next
'Pour information temps de la procédure avec réactivation de la fonction rafraichissement de l'Ecran
res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
Application.ScreenUpdating = True
If nb = 0 Then
dd = MsgBox("Aucun doublon trouvé dans la colonnne " & UCase(choix2) & " ...", 64, "Résultat")
Else
dd = MsgBox(nb & " lignes doublons passés en rouge (en " & res_test & " secondes)", 64, "Résultat")
End If
Range("D12").Select
'Affichage des doublons
RepAffichage = MsgBox("Voulez-vous afficher les doublons ?", vbYesNo + vbQuestion, "Affichage des doublons")
If RepAffichage = vbNo Then
Exit Sub
Else
LE1 = Range("D65536").End(xlUp).Row
End If
Range("D12").Activate
Rows("13:13").Select
Selection.AutoFilter
Application.ScreenUpdating = True
ActiveSheet.Range("A14:AA" & LE1).AutoFilter Field:=5, Criteria1:=CR
ActiveWindow.SmallScroll Down:=-1
Range("D12").Select
'Elimination (éventuelle) des doublons
RepAffichage = MsgBox("Voulez-vous supprimer un doublon (commande exécutée à la restauration du Fichier) ?", vbYesNo + vbQuestion, "Suppression des doublons")
If RepAffichage = vbNo Then Exit Sub
NL = InputBox("Veuiller entrer le numéro de la ligne à effacer", "Effacement des doublons")
End Sub
Bon courage,
Boucoiran