RechercheV boucle VBA

Fermé
Joannie - Modifié par Joannie le 30/03/2010 à 04:45
zebulon2503 Messages postés 1228 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 11 février 2016 - 30 mars 2010 à 14:17
<coBonjour,

Voici mon problème. Mon problème est sur une même feuille mon (affectation = référence). Je fais une rechercheV d'une ''Donnée'' dans la colonne B (envion 100 données) correspondant à une ''référence'' colonne A.

Par contre, parfois mon affectation correspond à une références qui affiche 2 ou 3 fois dans ma colonne A correspondant ainsi à 2 ou 3''données'' de la colonne B, alors je n'obtiens pas toutes les données correspondantes à mon affectation.

Pour récapituler, la colonne affectation contient toujours 1 seule fois la valeur recherchée, mais cette valeur peut correspondre à plusieurs données car la même référence peut s'afficher plusieurs fois dans la colonne dans certains cas.

Mon problème est que la rechercheV va chercher seulement la première valeur qu'elle repère dans la colonne B pour l'expédier dans la colonne désirée soit I.

Comment puis-je obtenir toutes les données correspondant à mon affectation et les reporter dans la colonne I ?

Exemple


Référence 'Données'' ______Affectation _''Données reportée''
274743 | ABBA ___| _______|274743 | ABBA |
387459 | BAAB ___| ______ | _______|CAAC |
274743 | CAAC ___| ______ | 387459 | BAAB |



J'ai obtenu le code ci-dessous sur le net, je ne sais pas si je dois utiliser cela?

Je sais qu'il faut que je créer une boucle avec du code VBA mais je n'ai aucuine idée à quoi peut ressembler ce code.

Merci beaucoup de m'aider, c'est très gentil


Sub options()
Dim Model As String
Dim cells As Range
Dim i
Model = ActiveCell.Value
i = 2
For Each cells In Worksheets('options').Range('A1:A' & Worksheets('options').Range('A65536').End(xlUp).Ro w)
If cells.Value = Model Then
ActiveCell.Offset(0, i) = cells.Offset(0, 1).Value
i = i + 1
End If
Next
End Sub


(à mettre dans un module) devrait fonctionner
tu te places sur la cellules ou tu veux les options et tu lances la macrosnfig>Windows XP / Internet Explorer 7.0</config>

2 réponses

zebulon2503 Messages postés 1228 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 11 février 2016 110
30 mars 2010 à 13:47
Salut

Dans quelle colonne mets tu les références, les données à copier, les affectation et les données copiées ?
Donnes moi ces infos et je peux te filer la macro magique :-)
A+
0
zebulon2503 Messages postés 1228 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 11 février 2016 110
30 mars 2010 à 13:50
Et ton affectation, tu la rentres à la main ou ca doit être automatique aussi ?
0
zebulon2503 Messages postés 1228 Date d'inscription jeudi 17 avril 2008 Statut Membre Dernière intervention 11 février 2016 110
Modifié par zebulon2503 le 30/03/2010 à 14:20
Bon, en attendant ta réponse, voici le code en partant du principe que les affectations sont remplies automatiquement.

Pour le test, j'ai mis les références colonne A, les données en B, les affectations en D et les données recopiées en E.
Sur la ligne 1, il y a le titre de la colonne (Référence, Données...), donc les données à traiter commencent à la ligne 2.

Sub test()
Application.ScreenUpdating=False
Dim Reference as String 
Dim Last_Row As Double  
Cells(1, 1).Activate  
Do Until ActiveCell.Value = ""  
    ActiveCell.Offset(1, 0).Select  
Loop  
Last_Row = ActiveCell.Row  

For i = 2 To Last_Row  
    Cells(i, 1).Activate  
    Reference = ActiveCell.Value  
          
    Cells(2, 4).Activate  
    Do Until ActiveCell.Value = ""  
        ActiveCell.Offset(1, 0).Select  
    Loop  
    ActiveCell.Value = Reference  
    ActiveCell.Offset(0, 1).Select  
    ActiveCell.Value = Cells(i, 2).Value  
Next i  

Range(Cells(2, 4), Cells(Last_Row - 1, 5)).Select  
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _  
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _  
    DataOption1:=xlSortNormal  
      
For i = Last_Row To 2 Step -1  
    Cells(i, 4).Activate  
    If ActiveCell.Value = Cells(i - 1, 4).Value Then  
        ActiveCell.ClearContents  
    End If  
Next i  
End Sub
MsgBox("Action Completed")


Tu peux lancer la macro à partir d'un bouton présent dans la même feuille si tu veux, le code pour ce bouton sera (si tu gardes le nom de ma procédure et avec un bouton nommée "CommandButton_1") :
Private Sub CommandButton1_Click()  
Call test  
End Sub  


Dis moi si ca te va.
A+

Les cons peuvent avoir l'air intelligent à première vue... Heureusement pour eux que la vitesse de la lumière est supérieure à celle du son.
0