Reconnaissance de cellules

Bonjour la communauté !

J'aimerais créer un code capable de lire 2 colonnes côtes à côtes, l'une contenant des valeurs, l'autre contenant les entêtes de ces valeurs. Le but étant d'identifier pour chaque entêtes la valeur correspondante afin de les replacer à coté d'une autre colonne contenant les mêmes entêtes mais dans un ordre différent ...

Je vous ai perdu avec mes explications ?

Voici un exemple de la macro souhaitée :

COLONNE A          COLONNE B          COLONNE C          COLONNE D
(entêtes)          (valeurs)          (entêtes)          (valeurs)
    D                    4               A                  1
    B                    2               B                  2
    A                    1               C                  3
    C                    3               D                  4

/!\ Il ne s'agit pas d'un tri mais bien d'une reconnaissance de cellule /!\

Le but est de replacer les valeurs en fonction de la place de l'entête dans la colonne C.

J'ai réussi avec un "range.cells.find" à identifier une cellule, mais j'aimerais l'appliquer sur des colonnes entières et je ne suis pas sûr que ce soit la même méthode.

Je vous joins mon fichier de test, dans lequel j'arrive à identifier une valeur unique par le biais du bouton " Trouves 'a' ".

En espérant que vos lumières m'éclairent

Merci,

Vbrod

12id-cells.xlsm (19.99 Ko)

Bonjour

A tester

Merci Banzai64,

C'est exactement ce que je voulais !

Je ne comprends pas tout dans ton code, mais il fonctionne parfaitement !

Encore merci

Banzai64,

En appliquant ton code à mon Excel j'ai une erreur qui survient :

Application.ScreenUpdating = False

For J = 5 To Workbooks(DOC2).Sheets("synthèse").Range("F" & Rows.Count).End(xlUp).Row
Set Cel = Workbooks(DOC).Sheets("niveau 3").Columns("A").Find(what:=Workbooks(DOC2).Sheets("synthèse").Range("F" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Adress
Do
Cel.Offset(0, 1) = Workbooks(DOC2).Sheets("synthèse").Range("G" & J)
Set Cel = Workbooks(DOC).Sheets("niveau 3").Columns("A").FindNext(Cel)
Loop While Cel.Adress <> Depart
End If
Next J

L'erreur annonce : "Propriété ou méthode non gérée par l'objet"

C'est bizarre, il fonctionne parfaitement sur le fichier que tu m'as envoyé, mais là il bloque ...

Serais-tu d'où cela pourrait venir ?

Merci

Vbrod

Bonjour

A première vue il manque un d dans Address

Depart = Cel.Address

A remplacer dans 2 endroits

Ah oui d'accord, je ne sais pas écrire Merci.

Cependant, après avoir corrigé mon ortographe j'ai un autre type d'erreur qui pointe le bout de son nez :

"variable objet ou variable de bloc with non définie"

For J = 5 To Workbooks(DOC2).Sheets("synthèse").Range("F" & Rows.Count).End(xlUp).Row
Set Cel = Workbooks(DOC).Sheets("niveau 3").Columns("A").Find(what:=Workbooks(DOC2).Sheets("synthèse").Range("F" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
Cel.Offset(0, 1) = Workbooks(DOC2).Sheets("synthèse").Range("G" & J)
Set Cel = Workbooks(DOC).Sheets("niveau 3").Columns("A").FindNext(Cel)
Loop While Cel.Address <> Depart
End If
Next J

Bonjour

Désolé mais je ne vois pas ce qui peut clocher

Il me faudrait les 2 fichiers pour tester

Bonjour,

Tu trouveras ci-joint mes 2 fichiers, j'ai du alléger le fichier à importer car il était trop lourd, mais ça devrait quand même fonctionner.

Étapes à suivre :

  • Sur la feuille "START" de l'outils de synthèse, faire "importer véhicule"
  • Sélectionner l'autre fichier

A la base l'outils de synthèse vient juste copier/coller les données intéressantes du fichier de cotations global dans ses feuilles, cependant il serait plus judicieux de détecter les cellules afin que si les infos ne sont pas dans le bon ordre, il les replace automatiquement.

Le morceau de code avec lequel je me bats est situé dans le module "ImportVehicule"

Je te laisse jeter un coup d’œil.

Merci

Bonjour

A cause des cellules fusionnées dans la page Niveau 3 et la fonction Find

Je présume qu'il n'y a qu'une fois les intitulés dans cette page

Remplace la partie correspondante

  Application.ScreenUpdating = False

  With Workbooks(DOC2).Sheets("synthèse")
    For J = 5 To .Range("F" & Rows.Count).End(xlUp).Row
      If .Range("F" & J) <> "" Then
        Set Cel = Workbooks(DOC).Sheets("niveau 3").Columns("A").Find(what:=.Range("F" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
          Cel.Offset(0, 1) = .Range("G" & J)
        End If
      End If
    Next J
  End With

  With Range("B2:S59")
    .HorizontalAlignment = xlCenter

Bonjour,

Tout à fait il n'y a qu'une fois les intitulés.

C'est parfait ! Merci de m'avoir accordé de ton temps

Rechercher des sujets similaires à "reconnaissance"