Problème VBA
Résolu
Bonjour,
Je suis à la recherche d'une idée pour résoudre un problème simple (sauf pour moi)
j'ai sous excel une suite de numéro :
10
10
12
14
16
16
16
16
18
20
...
J'aimerais dans un premier temps pouvoir garder tous les nombres en double et supprimer ceux qui son seul. Et dans un deuxième temps,en repartant de la même liste faire l'inverse, c'est à dire garder les nombres seul et supprimer ceux qui sont en double.
J'essaye depuis un certain temps de trouver une solution mais je me retrouve avec des if sans dessus dessous alors je vous demande si quelqu'un connait une méthode simple et efficace.
Merci
Je suis à la recherche d'une idée pour résoudre un problème simple (sauf pour moi)
j'ai sous excel une suite de numéro :
10
10
12
14
16
16
16
16
18
20
...
J'aimerais dans un premier temps pouvoir garder tous les nombres en double et supprimer ceux qui son seul. Et dans un deuxième temps,en repartant de la même liste faire l'inverse, c'est à dire garder les nombres seul et supprimer ceux qui sont en double.
J'essaye depuis un certain temps de trouver une solution mais je me retrouve avec des if sans dessus dessous alors je vous demande si quelqu'un connait une méthode simple et efficace.
Merci
6 réponses
-
Salut !
As-tu essayé avec la fonction Count If ?
Voilà un code qui pourrait résoudre ton premier problème si tu as une liste de 20 nombres située dans la colonne A par exemple :
Sub Test()
For i = 1 To 20
Cells(1, 2).Value = WorksheetFunction.CountIf(Columns(1), Cells(i, 1).Value)
If Cells(1, 2).Value = 1 Then
Cells(1, 2).Value = ""
End If
Next i
End Sub
Pour ton deuxième problème, tu n'as qu'à remplacer le "=1" par ">1" !
En espérant t'avoir aidé ! -
bonjour,
si j'ai bien compris ton problème, tu ne veux que garder les nombres qui apparaissent deux fois car:
_ tu ne gardes que ceux qui apparaissent deux fois
_ puis tu ne gardes que si ils sont seuls
Pour que la macro fonctionne, il faut que ta liste soit triée!!!
et en plus ca va inscrire une formule en colonne 2, j'espère qu'il n'y a pas de données.
Sub x()
i = 1
Do While i <= 60000 'va regarder ta liste de la première ligne à la 60000
Cells(i, 2).Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R" & i + 1 & "C[-1]:R60000C[-1], rc[-1])"
If Cells(i, 2) <> 1 Then
Range(Rows(i), Rows(i + Cells(i, 2))).Select
Selection.Delete Shift:=xlUp
i = i - 1
Else
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
i = i + 1
Loop
End Sub-
-
-
Non, n'est pas conforme a mon besoin.
Liste de départ :
15
10
10
10
8
20
20
15
Au final j'essaie d'avoir dans mon 1er cas (supprimer les uni-nombre):
10
10
10
20
20
Au final j'essaie d'avoir dans mon 2ème cas (supprimer les multi-nombre):
15
8
15
Je cherche également une solution de mon côté pour résoudre ce casse tête
-
-
ContributeurBonjour,
éventuellement tu peux le faire sans vba :
Insérer une colonne B et une ligne 1 pour les titres de colonne.
- en B2 : =ET(NB.SI(A:A;A2)>1;EQUIV(A2;A:A;0)=LIGNE()) à recopier vers le bas
- mettre un filtre automatique en ligne 1 et sélectionner les FAUX en colonne B
- sélectionner la 1ère ligne, shift+clic sur la dernière, clic-droit et 'supprimer la ligne'
Il ne reste plus que le 1er exemplaire des doublons.
http://www.cijoint.fr/cjlink.php?file=cj201108/cijEyxEtEC.xls
eric -
bonjour,
Maintenant que j'ai mieux compris ton besoin, essaie cette petite macro
en colonne 2, tu auras ta liste des multinombres
en colonn3, tu auras ta liste des nombres seuls.
Sub x()
i = 1
a=2
c=2
Do While i <= 60000 'va regarder ta liste de la première ligne à la 60000
'si ton nombre est égal au nombre de la ligne suivante
if cells(i,1) = cells(i+1,1) then
cells(a,2) = cells(i,1)
b=1
do while cells(i,1) = cells(i+b,1)
b=b+1
loop
i=i+b
a=a+1
else
cells(c,3) = cells(i,1)
end if
Loop
End Sub-
j'ai fait une petite bourde dans ma macro, copie celle là :
Sub x()
i = 1
a=2
c=2
Do While i <= 60000 'va regarder ta liste de la première ligne à la 60000
'si ton nombre est égal au nombre de la ligne suivante
if cells(i,1) = cells(i+1,1) then
cells(a,2) = cells(i,1)
b=1
do while cells(i,1) = cells(i+b,1)
b=b+1
loop
i=i+b
a=a+1
else
cells(c,3) = cells(i,1)
c=c+1
i=i+1
end if
Loop
End Sub
-
-
Vos techniques me paraissent la bonne méthode, je vais m'en inspirer. Je vous direz si j'ai réussi d'ici peu
Puis-je enregistrer la valeur d'une case (6 chiffres maximum, positif) de cette manière ? :
DIM x as long x=cells(1;1).value
-
-
ModérateurBonjour,
Effectivement, un nombre à 6 chiffres, sans décimales, est stocké en VBA sous le type Long. Pour info, Long : Nombre entier codé sur 4 octets (32 bits) et dont la valeur est comprise entre -2 147 483 648 et 2 147 483 647.
Le code que tu donnes est donc exact.
Pour continuer sur ta question initiale, ta liste de nombres est longue? combien de lignes? -
-
ModérateurAlors, si j'ai bien compris, il s'agit juste d'une partie d'une plus grosse procédure?
Si tel est le cas, j'alimenterais deux variables tableaux pour pouvoir les restituer ultérieurement dans le code.
Comme ceci :Option Explicit Sub ReconstitutionAvecEtSansDoubles() 'déclaration des variables Dim TabloDoublons() 'As Long 'apostrophe à ôter si on est sur que ce ne sont que des nombres Dim TabloSingle() 'As Long 'apostrophe à ôter si on est sur que ce ne sont que des nombres Dim DrLig As Integer, Lig As Integer, Ind1 As Integer, Ind2 As Integer 'les variables Ind servent d'indices à nos variables tableaux. Ind1 = 0 Ind2 = 0 'DrLig stocke le numéro de la dernière ligne col A de la feuille Feuil1 A ADAPTER DrLig = Sheets("Feuil1").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row 'on boucle sur toutes les lignes de la colonne A For Lig = 1 To DrLig 'Si NB.SI(ColonneA, ActiveCell) > 1 (si on a la même valeur plus d'une fois) If WorksheetFunction.CountIf(Columns(1), Cells(Lig, 1).Value) > 1 Then 'alors on la stocke dans la variable tableaux "doublons" ReDim Preserve TabloDoublons(Ind1) TabloDoublons(Ind1) = Cells(Lig, 1).Value Ind1 = Ind1 + 1 'sinon, donc si NB.SI(ColonneA, ActiveCell) = 1 (si on a la même valeur qu'une fois) Else 'alors on la stocke dans la variable tableaux "Single" ReDim Preserve TabloSingle(Ind2) TabloSingle(Ind2) = Cells(Lig, 1).Value Ind2 = Ind2 + 1 End If 'et on passe à la cellule suivante Next 'A partir d'ici, les 6 lignes de code suivants restituent les valeurs contenues dans nos variables 'tableaux respectivement en colB et col C. 'si tu veux voir le résultat, enlève les apostrophes au début de chacune de ces lignes 'For Lig = 0 To UBound(TabloDoublons) ' Cells(Lig + 1, 2) = TabloDoublons(Lig) 'Next 'For Lig = 0 To UBound(TabloSingle) ' Cells(Lig + 1, 3) = TabloSingle(Lig) 'Next End Sub
-
-
Voila je suis enfin parvenu à un résultat correct grâce à vos code et vos idées, mon code est basic mais fonctionne. Merci
J'ai fais encore plus simple, de ma liste, tout les numéros seul sont déplacés vers une autre page et de ce fait j'aurais ma séparation. Les lignes vides seront supprimer par la suite.
Sub Séparation_Multiconducteurs()
Dim mémorisation As Long Dim nb_ligne As Integer Dim ligne As Integer Dim boucle_ligne As Boolean Sheets("M_3,2").Select nb_ligne = Cells.Find("*", , , , , xlPrevious).Row ligne = 1 mémorisation = Cells(ligne, 1).Value retour: If boucle_ligne = False Then If WorksheetFunction.CountIf(Columns(1), Cells(ligne, 1).Value) = 1 Then Rows(ligne).Select Application.CutCopyMode = False Selection.Copy Sheets("M_3,2_U").Select Rows(ligne).Select ActiveSheet.Paste Sheets("M_3,2").Select Rows(ligne).Select Selection.ClearContents End If If ligne = nb_ligne Then boucle_ligne = True ligne = ligne + 1 GoTo retour End If
Si quelqu'un veut s'amuser à l'optimiser, je ne suis pas contre, car pour l'instant ce n'est pas dans mes priorités.
Sujet résolu
Merci à tous, bonne continuation
