Sujet Précédent Sujet Suivant

Problème VBA

Résolu/Fermé
dubolg - 16 août 2011 à 15:42
 dubolg - 17 août 2011 à 11:58
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

6 réponses

Réponse 1 / 6
Schtroumpf_Wiki
16 août 2011 à 16:03
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é !
0
Réponse 2 / 6
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
16 août 2011 à 16:08
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
0
dubolg
16 août 2011 à 16:16
Je voulais dire dans le 1er cas, tous les nombres qui apparaissent 2x ou plus seront gardés, les autres seront supprimés.

Les numéros de ma liste sont dans le désordre mais quand il y a plusieurs fois le même ils se suivront (ex: 15, 10, 10, 10, 8, 20, 20, 15, ...)
0
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
16 août 2011 à 16:28
oui, j'ai oublié un bout de phrase mais essaie ma macro et vois si ca répond à ton besoin.

de ta liste :
15
10
10
10
8
20
20
15

il ne restera plus que 20.
0
dubolg
16 août 2011 à 16:42
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
0
Réponse 3 / 6
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 247
Modifié par eriiic le 16/08/2011 à 16:47
Bonjour,

é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
0
dubolg
16 août 2011 à 16:53
Merci mais je dois l'automatiser, petit module d'une grande macro
0
Réponse 4 / 6
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
17 août 2011 à 08:20
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
0
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
17 août 2011 à 08:21
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
dubolg
17 août 2011 à 08:21
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
0
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
17 août 2011 à 08:28
non plutôt comme ca :

dim x as variant

x = cells(1,1).value
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
17 août 2011 à 08:31
Bonjour,
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?
0
dubolg
17 août 2011 à 10:31
Tout dépend, elle peut aller de 1 ligne à 2000.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
17 août 2011 à 10:57
Alors, 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
0
Réponse 6 / 6
dubolg
17 août 2011 à 11:58
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
0

Discussions similaires

"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses
ouverture d'un fichier excel à partir d'un code VBA
TraderAS -
pijaku -

3 réponses
Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse
appliquer une pause dans une macro vba excel
ch'duj -
lerif25 -

10 réponses