Trouver le double de la cellule active dans une colonne
Bonjour à tous
Je suis nouveau sur ce forum, qui cela dit en passant, je consule énormément depuis 2 semaines, suite à une formation VBA.
Je n'arrive cependant pas à trouver la solution à mon problème du moment :
J'ai une série de chiffres dans la colonne B. Le but est de faire une moulinette qui teste toutes les cellules de la colonne avec pour but de trouver son double, dans la même colonne.
J'ai bien pensé à une boucle du style : for each cellule .... mais je pense que cela risque d'être long pour passer les 2500 lignes en revue.
Je suis parti sur l'instruction :
activeCell.value = MaVariable
if range("B:B").Value like Mavariable then,
=> colorier la cellule en rouge, par exemple
et là çà coince, il passe outre alors que l'instruction devrait renvoyer TRUE.
Je suis preneur de toute astuce ...
Au besoin, je fournirai un fichier modèle avec mes données.
Merci d'avance
Frédéric
Bonsoir
blackrt a écrit :Au besoin, je fournirai un fichier modèle avec mes données.
Oui très bonne idée
Tu y notes ce que tu veux obtenir
Banzai64 a écrit :Bonsoir
blackrt a écrit :Au besoin, je fournirai un fichier modèle avec mes données.
Oui très bonne idée
Tu y notes ce que tu veux obtenir
Bonjour
voici donc le fichier Excel, avec sa macro associée.
C'est un fichier issu d'une base généalogique. Chaque individu est unique et repéré par un N° , appelé ici Sosa.
Le père d'un individu a un n° double de l'individu testé, sa mère le double +1.
Je cherche via cette macro à tester si un individu a des parents connus en cherchant le double de son numéro d'identification.
Cà coince sur la ligne de cde qui recherche le double du numéro de la cellule active.
Voici le code :
Sub FinLignee()
' Test si un individu est fin de lignée
Range("b2").Select
Dim Sosa As Long
Dim Sosa2 As Long
Dim SosaCol As Range
Set SosaCol = Range("B:B")
Do While ActiveCell <> ""
Sosa = ActiveCell.Offset(1, 0).Value
Sosa2 = 2 * Sosa
If SosaCol.Value Like Sosa2 Then
' Pas d'action, il a un père connu dans la base
Else
ActiveCell.Font.Color = RGB(255, 0, 0)
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubMerci d'avance pour votre aide.
Frédéric
Bonjour,
lorsque tu as beaucoup de données il travailler en mémoire en chargeant en bloc dans un tableau toutes les données utiles, et ensuite travailler sur ce tableau.
Seulement là tu vas avoir un nombre considérable de boucles.
Je pense que le mieux est d'avoir une seule boucle et d'utiliser la méthode .find pour trouver père et mère.
Je t'ai ajouté une colonne des fois que ça te serve pour filter avec :
0 : pas de parents
1 : père uniquement
2 : mère uniquement
3 : père et mère
Sub pèreMère()
Dim derlig, parents As Long
Dim plage As Range, père As Range, mère As Range, c As Range
'Application.ScreenUpdating = False
derlig = Cells(Rows.Count, 1).End(xlUp).Row
' nettoyer
Range("C2:E" & derlig).ClearContents
Range("B:B").Font.ColorIndex = xlAutomatic
'
Set plage = Range(Cells(2, "B"), Cells(derlig, "B"))
For Each c In plage
parents = 0
Set père = plage.Find(c * 2, LookIn:=xlValues, lookat:=xlWhole) ' recherche père
Set mère = plage.Find(c * 2 + 1, LookIn:=xlValues, lookat:=xlWhole) ' recherche mère
' inscription parents
If Not père Is Nothing Then ' père trouvé
c.Offset(0, 2) = père.Offset(0, -1)
parents = 1
End If
If Not mère Is Nothing Then ' mère trouvée
c.Offset(0, 3) = mère.Offset(0, -1)
parents = parents + 2
End If
c.Offset(0, 1) = parents
' couleur
Select Case parents
Case 0 ' pas de parents
c.Font.ColorIndex = 3 ' rouge
Case 1 ' père uniquement
c.Font.ColorIndex = 10 ' vert
Case 2 ' mère uniquement
c.Font.ColorIndex = 5 ' bleu
Case 3 'père + mère
' c.Font.ColorIndex = xlAutomatic ' pas de couleur, fait en bloc dans 'Nettoyer
End Select
Next c
Application.ScreenUpdating = True
End Suberic
PS: j'ai oublié d'enlever le ' devant 'Application.ScreenUpdating = False
à faire si tu veux accélérer le traitement
Bonjour
Bonjour eriiic : Même idée (pour la recherche)
A tester
Merci beaucoup Eric pour ce coup de pouce.
J'ai désactivé l'ajout de colonnes car çà mettrait le bazzare dans d'autres macro qui bosse avec le n° de colonne (en attendant que je trouve comment bosser avec un nom de colonne).
J'ai également désactiver la couleur auto de la colonne, j'ai déjà des cellules colorées ...
J'ai compris le code, c'est déjà pas mal.
Dans celui que j'avais imaginé ... pourquoi est ce que je n'arrivais pas à chopper le double de la cellule active avec la ligne if ... like 'donnée numérique', pour ma culture!
Merci encore
Frédéric
Re,
Tu peux remarquer que banzai et moi avons fait le même choix de traitement, ça ne doit pas être le pire
D'ailleurs il est de bon ton de remercier tous les intervenants qui ont passé du temps toi, même s'ils répondent à coté car ils ont eu une autre interprétation...
If SosaCol.Value Like Sosa2 Then
Pour moi beaucoup d'anomalies en une seule ligne.
Like est un opérateur chaine qui sert à dire si une chaine 'ressemble' à une autre définie en tant que pattern (masque si tu veux).
Par exemple A2 like [A-F]# retournera True .
Toi tu t'en sers pour essayer de comparer un tableau (issu d'un range) avec un long, peu de chance d'en sortir qcq chose...
A la limite comparer 2 long serait passé mais perturbant et inadéquat.
En vba il faut bien être attentif au type des variables. C'est bien, tu les as toutes typées au début, garde cette habitude. Même si ça te sort plus d'erreurs au moins ça te permet de déboguer correctement plutôt que de te retrouver plus tard avec des résultats 'bizarres' dont tu ne trouves la cause.
En vba pour savoir si une valeur est dans un tableau pas d'autre moyen que de boucler sur toutes les valeurs et de tester avec =.
Sinon tu as les dictionary qui évitent la boucle mais là je ne pense pas que c'était utilisable. Ce sont des tableaux avec des avantages, mais beaucoup de restrictions. Et garde ça pour quand tu seras ceinture marron...
eric
Bonjour
Je pensais que like fonctionnait aussi avec du numérique.
Si j'avais fait 'F1', j'aurais eu l'info.
Merci à Eric et Banzai pour leur aide.
Frédéric, encore ceinture blanche !