VBA prob de doublon - VB/VBA/VBS - Programmation
Marsh Posté le 08-03-2013 à 16:02:53
Bonjour, avant d'ajouter un n° de série, vérifier son existence dans la colonne via la méthode Find
l'aide intégrée de VBA est une amie …
Afin que l'exécution soit moins ralentie par ces affreux Activate / Select (travailler directement sur l'objet est plus sain),
mieux vaut désactiver le rafraîchissement de l'écran en début de procédure (propriété ScreenUpdating).
Pour ces deux points, voir aussi l'exemple dans le récent sujet Macro pour supprimer une ligne.
Autre astuce intéressante dans ce sujet, comment directement trouver la dernière saisie d'une colonne …
Une boucle While {…} Wend est obsolète, lui préférer Do {…} Loop bien plus rapide …
Marsh Posté le 08-03-2013 à 15:39:29
Bonjour,
J'ai un probleme avec mon programme qui me genere des doublons.
Le principe de mon programme est le suivant : Je cherche dans mon tableau ce trouvant dans l'onglet "inventory" tous les numeros de serie se trouvant en reparation (repair) ou en stock (spare). Ces num de serie se trouvant en reparation ou en stock, sont alors classes dans un autre onglet (nom de l'onglet "Repair or Spare" ) automatiquement quand je clique sur un bouton (bonton sur lequel j'ai affecte ma macro).
Jusque la tout va niquel, les numeros de serie en reparation vont dans le tableau des reparations, les num se trouvant en stock vont dans le tableau des stocks, le tri est parfaitement realise.
Le prob vient seulement si je re-clic sur le bouton pour faire le tri, cela me cree des doublons. Je me retrouve avec deux fois le meme num de serie. J'aimerais pouvoir faire en sorte que si le num de serie a deja etait trie il ne faut pas l'ajouter dans la liste.
Est-ce quelqu'un aurait une solution a m'apporter?
Voici mon petit programme :
Sub itii2()
Sheets("Repair or Spare" ).Select 'Remise à Zéro de la feuille "Repair or Spare"
Application.Goto Reference:="RAZ"
With Selection.Interior
.Pattern = xlNone
End With
Selection.ClearContents
Sheets("Inventory" ).Select 'se placer sur la bonne feuille au debut
Range("A2" ).Select
While ActiveCell.Value <> "" ' boucle pour traiter de la premiere a la derniere ligne de "serial number"
ActiveCell.Offset(1, 0).Select
ActiveWorkbook.Names.Add Name:="ici", RefersToR1C1:=ActiveCell ' on nomme la case ou l'on est pour y retourner plus facilement
serialnumber = ActiveCell.Value 'capter le numero de serie
serialcouleur = Selection.Interior.Color 'capter la couleur de la case du numero de serie
ActiveCell.Offset(0, 1).Select 'passer a la colonne range
rangenumber = ActiveCell.Value 'capter le numero de range
rangecouleur = Selection.Interior.Color 'capter la couleur de la case du numero de range
ActiveCell.Offset(0, 2).Select 'passer a la case de la location
Location = ActiveCell.Value 'capter la valeur de la location
Sheets("Repair or Spare" ).Select 'se placer sur la feuille "Repair or Spare"
Range("A4" ).Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
Select Case Location 'liste des differents cas de figure suivant la "location"
Case Is = "Repair" ' dans le cas ou le numero de serie serie dans la location "Repair"
ActiveCell.Offset(0, 0).Select
ActiveCell.Value = serialnumber
Selection.Interior.Color = serialcouleur 'ecriture du numero de serie et mise en couleur de la case
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = rangenumber
Selection.Interior.Color = rangecouleur
Case Is = "Spare"
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = serialnumber
Selection.Interior.Color = serialcouleur
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = rangenumber
Selection.Interior.Color = rangecouleur
End Select
Application.Goto Reference:="ici" ' retour sur la feuille "inventory" a l'endroit ou l'on est parti nommé "ICI"
Wend
End Sub