XL 2016 Trie d'information dans des cellules

[Bambi35]

Bonjour a tous
Je viens vers vous pour de l'aide.
Je cherche à répartir les informations de la Feuille "Base" sur la Feuille "Colonnes1" en passant par du VBA

Sur le Base j'ai CRO en"A2" et P,E,T sur "B2"
et PAT en"A3" et O sur "B3"
etc...

sur le Feuille "Colonne1 avoir
CRO en"A2" et P sur "B2"
CRO en"A3" et E sur "B3"
CRO en"A4" et T sur "B4"
PAT en"A5" et O sur "B5"
etc...

Je vous ai déjà demandé il y a quelque temps mais je m'arrive pas à modifier le VBA, et J'aimerai n'avoir que ce code sur cette feuille.


Merci de votre aide


Bambi35

 

[Bambi35]

Bonjour Job75
C'est nickel pour le résultat , mais pour rajouter 1 ou 2 feuilles et changer le titre des Feuilles je n'arrive pas a savoir quel sont les données à modifier . J'ai bien vu que tu as nommé une colonne et une section mais pour ton script il est très concentré. J'ai encore besoin d'aide pour pouvoir ajouter une feuille et les renommer
Merci à toi
Merci à toi aussi Vgendron

Bambi35

 

[job75]

Vous pouvez ajouter autant de colonnes que vous voulez dans la feuille "Base".

Mais les feuilles correspondantes doivent être créées et s'appeler "Colonne1","Colonne2", etc...

 

[Bambi35]

Vous pouvez ajouter autant de colonnes que vous voulez dans la feuille "Base".

Mais les feuilles correspondantes doivent être créées et s'appeler "Colonne1","Colonne2", etc...

Job75
Je fais le test . ok Nickel , Plus simple que complique ,mais le nom de la feuille aurai été un plus pour la recherche.
Merci encore de ton aide

@+++++
Bambi35

 

[job75]

Bonjour Bambi35, vgendron,

le nom de la feuille aurai été un plus pour la recherche.

Vous pouvez donner aux feuilles les noms que vous voulez.

Il suffit de les lister dans un Array, fichier (2) :

Dim feuille, col As Variant, nlig&, resu(), tablo, i&, nom$, s, ub%, j%, n&, x$, p%
feuille = Array("ID", "PRO") 'liste des feuilles, à adapter
col = Application.Match(Sh.Name, feuille, 0)
If IsError(col) Then Exit Sub
col = col + 1

A+

 

[Bambi35]

Bonjour Job78
Merci pour ton retour
Désolé pour ce retard je regarde demain
Merci encore
@++++Bambi35

 

[Bambi35]

Bonjour Job78
J'ai effectué les modifs et le résultat est ce que je voulais.

merci encore de ton aide
@++++
Bambi35

 

[Bambi35]

Bonjour à tous

Je vous avais demandé comment récupérer des info a partir d'une Base en code VBA pour les copier dans une colonnes sur une autre feuille . Chose faite.
j'ai réalisé le fichier qui regroupe les informations
Aujourd'hui je relance le sujet car je n'arrive pas à rajouter deux autres informations dans deux autres colonnes
Je ne sais pas comment modifier le VBA.
Exemple pour ACR-196/F;Porte2
En colonne "B" de la feuille ACR j'ai "ACR-196" avoir en colonne "C" avoir "F" et en colonne "D" avoir "Porte2"

Merci de votre aide

Bambi35

 

[job75]

Bonsoir Bambi35,

Je ne vois pas le rapport avec ce qu'on a fait précédemment.

Et ce n'est guère compréhensible.

Joignez un fichier avec tous les résultats attendus.

A+

 

[Bambi35]

Bonjour Job75
Merci pour votre retour

Voici le fichier avec le résultat en Jaune attendu en "Feuille ACR"

Bambi35

Merci d'avance

 

[job75]

Merci, pas sûr d'avoir le temps de faire ça ce soir.

 

[Bambi35]

Merci, pas sûr d'avoir le temps de faire ça ce soir.

Pas de problème , pour complément d'info le but de rajouter la colonne "C" ( colonne "D" en prévision) est de voir si on est en accord avec les informations de la feuille "Tracking" car si ce n'est pas le cas j'aurai en Colonne "E" erreur Indice

Merci à vous et bonne fête de fin d'année

Bambi35

Cordialement

 

[job75]

Le fichier en retour, voyez la feuille "ACR" et la macro du bouton dans Module1 :

Sub Ind_Base_Titre()
Dim d As Object, tablo, i&, s, j%, txt$, p%, x$, y$, z$
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Base")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("E1:F" & .Range("E" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo)
        s = Split(tablo(i, 1), ",")
        For j = 0 To UBound(s)
            txt = s(j)
            If txt Like "ACR*/*" Then
                p = InStr(txt, "/")
                x = Left(txt, p - 1)
                If Not d.exists(x) Then
                    y = Mid(txt, p + 1)
                    p = InStr(y, ";")
                    z = ""
                    If p Then z = Mid(y, p + 1): y = Left(y, p - 1)
                    d(x) = y & Chr(1) & z 'mémorise la chaîne
                End If
            End If
    Next j, i
End With
With Sheets("ACR")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B1:D" & .Range("B" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide
        tablo = .Value
        For i = 2 To UBound(tablo)
            x = tablo(i, 1)
            If d.exists(x) Then
                s = Split(d(x), Chr(1)) 'récupère la chaîne
                tablo(i, 2) = s(0)
                tablo(i, 3) = s(1)
            Else
                tablo(i, 2) = ""
                tablo(i, 3) = ""
            End If
        Next i
        .Value = tablo 'restitution
    End With
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

Bonne nuit.

 

[Bambi35]

Bonjour Job75
Merci encore pour votre aide ainsi que pour les info dans le VBA

Bonne fête de fin d'année à vous

Bambi35

 

[job75]

Bonjour Bambi35, le forum,

J'ai testé la macro du post #27 avec 10 000 cellules remplies en colonne E de la feuille "Base" :

- cellules identiques => 0,5 seconde

- cellules différentes => 0,6 seconde.

A+