A l'arrache... une petite macro pour résoudre un nombre important de
lignes. Ce qui est important pour éviter les ennuis : bien respecter
les variables NomFeuille, Col1, ...
J'ai mis des commentaires en espérant que ça suffise.
Bon surf,
Christian
Sub SupprimeDoublons
Dim oDocument As Object, oSheet As Object, oSheet1 As Object,
oSheet2 As Object, oCell1 As Object, oCell2 As Object, oController
Dim Lig As Integer
Dim oRows
Dim oRange As Object
Dim NomFeuille As String
Dim Col1 As Integer, Col2 As Integer, Col3 As Integer, Col4 As
Integer
NomFeuille = "Tous"
Col1 = 2 'Nom et taille
Col2 = 3 'Saison
Col3 = 5 ' Prix achat
Col4 = 7 ' Uniquement pour tests (affichage DOUBLON)
LigDebut = 4 ' ligne début comparaison
Feuil1 = thisComponent.sheets().getByName(NomFeuille)
' Affiche la bonne feuille au cas où...
ThisComponent.CurrentController.ActiveSheet = Feuil1
oController = ThisComponent.getCurrentController()
oDocument=ThisComponent
oSheet1=oDocument.Sheets.getByName(NomFeuille)
Lig = LigDebut
'MaVariable = MsgBox("Mon test", 64, "TEST")
Retour = MsgBox("Affichage DOUBLONS uniquement", 1+32, "Recherche
doublons")
If Retour = 1 Then
Retour2 = MsgBox("Suppression des lignes en doubles", 1+32,
"Recherche doublons")
Endif
Do
oCell1=oSheet1.getCellByPosition(Col1, Lig)
' Totalement inutile : ralentissement du programme, mais
visualise la progression
oController.select(oCell1) 'déplace vers la cellule active
NomTaille = Ucase(Trim(oSheet1.getCellByPosition(Col1,
Lig).String)) 'j'en profite pour supprimer les espaceas
avant/après et passer en majusucules pour éviter des erreurs
Saison = Ucase(Trim(oSheet1.getCellByPosition(Col2,
Lig).String))
PrixAchat = oSheet1.getCellByPosition(Col3, Lig).Value
If Lig + 1 > LigDebut Then ' début des comparaisons
If NomTaillePrec = NomTaille Then ' même article et
taille
If PrixAchatPrec < PrixAchat Then
If Retour = 1 Then
oSheet1.getCellByPosition(Col4, Lig).String =
"Doublon" ' uniquement si on passe les 4 lignes suivantes en REM
(sans action)
Endif
If Retour2 = 1 Then
oCell1=oSheet1.getCellByPosition(Col1, Lig)
oController.select(oCell1) 'déplace vers
la cellule active
oRows =
ThisComponent.CurrentController.ActiveSheet.Rows
oRows.removeByIndex(Lig,1)
Endif
Endif
Endif
Endif
NomTaillePrec = NomTaille
PrixAchatPrec = PrixAchat
If NomTaille = "" Then
Exit Do 'sortie de la boucle infernale
Endif
'
Lig = Lig + 1
Loop
'
MsgBox("Traitement terminé")
End Sub
Le 11/10/2020 à 13:17, Pingouin du bureau a écrit :
Le 11/10/2020 à 12:14, Pingouin du bureau a écrit :
Pour finir, j'ai récapitulé et j'ai fait une synthèse des réponses.
J'ai donc appliqué la formule de Christian et ensuite, j'ai fait le
copier coller spécial du résultat du test de Christian. Cela m'a
permis de trier toutes les lignes ayant une valeur VRAI ou 1 et de
les supprimer.
J'espère que je vais enfin pouvoir reprendre la mise en forme de mon
tableau.
Merci à tous ceux qui m'ont répondu et qui ont passé pas mal de
temps chercher et à rédiger leurs réponses :-)
Bon dimanche à tous.