Problème clé à l'aide d'un tableau vba

Version imprimable

Voir 40 message(s) de cette discussion en une page

12/08/2015, 11h54
aziz1015

Problème clé à l'aide d'un tableau vba

Bonjour,

J'aimerais concaténer dans la colonne K, toutes les cellules de la colonne B à qui ont des valeurs identiques dans la colonne A !

Quelqu'un aurait une idée sur la manière de le faire en VBA ?

Merci d'avance pour votre aide !
12/08/2015, 17h35
PMO2017
Citation:

je me dis donc qu'il faut que le tableau est 5 dimensions, une qui gère les lignes et 4 pour les colonnes !

Bonjour,

Vous pouvez récupérer toutes les données d'un seul coup
Code:

1 2 3 4 5 Dim Tb As Variant Tb = WsSource.Range("A1").CurrentRegion '--- Lit le contenu de la ligne 3 colonne 2 --- MsgBox Tb(3, 2)
Sans un fichier exemple de votre part, je ne vais pas plus loin.

Merci pour votre réponse, je ne savais pas cela ! J'ai changé mon approche ayant du mal avec les tableaux ! J'ai créé des clés avec la fonction "concaténer" directement avec Excel en colonne A par exemple, je souhaiterais concaténer toutes les cellules de la colonne B qui ont des clés identiques en colonne A dans la colonne C, j'ai trouvé un code que j'ai un peu bricolé mais il ne fonctionne pas :aie::aie:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub concatBsiA() Dim myR As String, myStr As String, c As Range myR = "B1:" & [B65536].End(xlUp).Address For Each c In Range(myR).Cells If WorksheetFunction.CountIf(Range(myR).Offset(-1, 0), c) > 0 Then myStr = myStr & c End If Next 'Je ne comprends pas vraiment à quoi sert cette ligne :aie: [D1] = myStr End Sub
Par ailleurs comment pourrais je appliquer une formule à une colonne qui contient plus de 100 000 lignes en Excel ? :aie:

Merci d'avance pour votre aide

12/08/2015, 18h06
PMO2017

Vous avez fait disparaître votre premier message (peu explicite quant au but recherché) en réécrivant dessus.
Du coup, c'est encore plus flou.

Que voulez-vous faire avec des clés ?

Un classeur exemple expliquant cela serait fort utile à ma compréhension.
12/08/2015, 18h36
aziz1015

1 pièce(s) jointe(s)

Citation:

Envoyé par PMO2017

Que voulez-vous faire avec des clés ?

Merci de votre aide,

En fait je dois créer des "périmètres" ! Dans mon fichier Excel, j'ai plusieurs filiales appartenant à un même groupe d'entreprise ! Un périmètre est composé en fait des filiales d'un même GROUPE qui ont les contrats (N°Contrat) présentant les mêmes caractéristiques, c'est à dire pour un même code PVC, ont le même prix et même code GT et le même nombre de lignes par contrat (l'inverse ne veut pas dire que c'est pas un périmètre) !

Pour faire ça, j'ai fait une cléA qui concatène pour chaque ligne, le prix et le code GT et une autre cléB qui concatène le GROUPE, le N°Contrat et le PVC ! Maintenant pour chaque cléB identitique, j'aimerais concaténer les clésA !

Le but étant d'avoir dans une nouvelle clé PVC&PriX1GARANTIE1&PRIX2GARANTIE2&PRIX3GARANTIE3 ... ensuite un tri sur cette colonne me donnerait mes potentiels périmètres !

En espérant avoir été clair !
12/08/2015, 21h12
clementmarcotte

Pourtant, hier, il y a quelqu'un qui t'a demandé de faire le ménage dans tes sujets précédents avant d'en rajouter. Plus tu laisses des questions en suspens, plus tu ajoutes de nouvelles questions, plus tu embêtes ceux qui essaient de te suivre.
12/08/2015, 21h30
aziz1015

Sauf erreur de ma part, ne sachant pas comment supprimer une discussion ! J'ai mis les discussions en "résolu" hier !

Cordialement
13/08/2015, 08h04
Theze

Bonjour,

Petite parenthèse, hier PMO2017 a posté une remarque que tu as probablement faite dans un autre post :

Citation:

je me dis donc qu'il faut que le tableau est 5 dimensions, une qui gère les lignes et 4 pour les colonnes !

Je pense que tu veux parler d'un tableau à deux dimensions. Pour t'imaginer un tableau à 5 dimensions, imagine 5 feuilles de calcul Excel empilées et voilà à quoi peut ressembler ce type de tableau un peu comme le Rumicube, autant te dire que c'est très difficilement gérable.

Hervé.

1 pièce(s) jointe(s)

Citation:

Envoyé par Theze

Je pense que tu veux parler d'un tableau à deux dimensions. Pour t'imaginer un tableau à 5 dimensions, imagine 5 feuilles de calcul Excel empilées et voilà à quoi peut ressembler ce type de tableau un peu comme le Rumicube, autant te dire que c'est très difficilement gérable.

Bonjour,

Merci de me répondre, Je m'en suis très vite rendu compte en effet ! Du coup, j'ai changé mon fusil d'assaut ! Je cherche à créer une clé plus facilement !

Pour toutes les valeurs identiques en colonne A, j'aimerais concaténer les valeurs en B ! et mettre la clé C !

Pièce jointe 185292

J'ai réussi à bricoler un code mais il me crée une clé pour toutes les lignes identiques alors que je veux seulement pour la première ligne identique :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 Option Explicit Private Sub Test_Click() Dim Dico, k, i Dim n As Integer Dim C As Range Application.ScreenUpdating = False Set Dico = CreateObject("Scripting.dictionary") For Each C In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row) If Not Dico.Exists(C.Value) Then Dico.Add C.Value, C.Offset(0, 3).Value Else If InStr(Dico.Item(C.Value), C.Offset(0, 3).Value) = 0 Then Dico.Item(C.Value) = Dico.Item(C.Value) & ", " & C.Offset(0, 3).Value End If End If Next C k = Dico.keys i = Dico.items For n = 0 To Dico.Count - 1 For Each C In Range("A2:A77") If C.Value = k(n) Then C.Offset(0, 5) = i(n) Next C Next n End Sub

13/08/2015, 11h52
Marc-L

Bonjour,

donc le dictionnaire ne sert pas à grand chose tel qu'il est utilisé dans ce cas précis !
Avec un peu de jugeote pourtant … La réflexion mène au code, pas le contraire !

Sinon sans dictionnaire, c'est simple via la méthode Find, la fonction de feuille de calculs TRANSPOSE et la fonction VBA Join …

Joindre un classeur exemple xlsx (sans code) et je regarderais plus tard si toujours pas de solution.

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse
13/08/2015, 12h27
aziz1015

Citation:

Envoyé par Marc-L

Bonjour,

donc le dictionnaire ne sert pas à grand chose tel qu'il est utilisé dans ce cas précis !
Avec un peu de jugeote pourtant … La réflexion mène au code, pas le contraire !

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

Bonjour,

Ici j'ai utilisé un exemple plus simple, aussi, je passe par le dictionnaire parce que mon fichier Excel est constitué de plusieurs centaines de lignes ! J'essaye de code quelque chose si je ne pas reçu je vous reviens avec un fichier test !

Merci pour votre aide
13/08/2015, 13h07
Marc-L

Si la première colonne est triée comme dans l'exemple affiché, pas besoin de dictionnaire …

bonjour,

d'après ce que j'ai compris (c'est vrai que c'est flou) ;)

tu peux t'inspirer de ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Dico, C, Col, Phrase, I
 
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each C In Range("A1:A6")
        If Not Dico.Exists(C.Value) Then Dico.Add C.Value, New Collection
        Dico.Item(C.Value).Add C.Offset(0, 1).Value
    Next C
 
    For Each Col In Dico.Items
        Phrase = ""
        i = 1
        For Each v In Col
            Phrase = v & " " & v
        Next v
        Cells(i, 5) = Phrase
        i = i+1
    Next Col

13/08/2015, 14h31
aziz1015

1 pièce(s) jointe(s)

Citation:

Envoyé par mayekeul

bonjour,

d'après ce que j'ai compris (c'est vrai que c'est flou) ;)

Bonjour,

Merci pour votre aide avant tout, j'ai l'impression que le code me remplace à chaque fois l'ancienne valeur par la nouvelle alors que c'est pas vraiment ce que je veux, je vous mets un classeur test en fichier joint

Pièce jointe 185346

Désolé d'expliquer aussi mal, ça me rend la tâche d'autant plus difficile car vous ne pouvez pas me donner correctement l'aide dont j'ai besoin rapidement :aie::aie:

En espérant que le fichier soit plus clair, je vous remercie !

essaye comme ça:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Dico As Scripting.Dictionary, C, Col, Phrase, I, K, V
 
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each C In Range("A2:A209")
        If Not Dico.Exists(C.Value) Then
            Dico.Add C.Value, New Collection
        End If
        Dico.Item(C.Value).Add C.Offset(0, 1).Value
    Next C
 
    For Each K In Dico.Keys
        Phrase = ""
        For Each V In Dico.Item(K)
            Phrase = V & " " & V
        Next V
        Range("A2:A209").Find(K).Offset(0, 10) = Phrase
    Next K

13/08/2015, 15h13
aziz1015

1 pièce(s) jointe(s)

Heu, ça ne fonctionne pas vraiment, ça fonctionne que pour les blocs identiques en colonne A à deux lignes ! Mais met la concaténation au "bon endroit" par contre, pour chaque bloc de cellules identiques dans la colonnes A, il concatène la dernière valeur de la colonne B avec elle-même :aie::aie::aie:

Pièce jointe 185360

Si un dictionnaire est utilisé, pas besoin de la méthode Find !
C'est comme du premier étage monter les escaliers jusqu'au dernier étage pour prendre l'ascenseur jusqu'au rez-de-chaussée ‼
De la jugeote, de l'imagination, que diable !

Qui plus est la méthode Find n'est pas fiable en cas de présence de caractères génériques * (comme dans la colonne A)
et ? dans la saisie, ils peuvent la berner …

Voici une correction de la colonne A remplaçant les caractères * :
Code:

1 2 3 4 5 6 7 Sub CorrectionSaisie() With Feuil1.Cells(1).CurrentRegion.Columns(1) VA = .Value For R& = 1 To UBound(VA): VA(R, 1) = Replace$(VA(R, 1), "*", "•"): Next .Value = VA End With End Sub
Une fois la colonne corrigée, Find nécessite moins de 0,3 seconde :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Demo1() Dim Rg As Range Application.ScreenUpdating = False With Feuil1.Cells(1).CurrentRegion.Columns(1) .Offset(1, 2).Clear Set Rg = .Cells(2) While Rg.Value > "" Set Rg = Range(Rg, .Find(Rg.Text, .Cells(1), xlValues, xlWhole, xlByColumns, xlPrevious, True)) If Rg.Count = 1 Then Rg.Offset(, 2).Value = Rg.Offset(, 1).Value _ Else Rg(1).Offset(, 2).Value = Join(Application.Transpose(Rg.Offset(, 1)), " | ") Set Rg = Rg(Rg.Count + 1) Wend End With Set Rg = Nothing End Sub
Si évidemment la colonne A doit rester en l'état, je reviendrais avec un dictionnaire sans Find …

_____________________________________________________________________________________________________
C’est ce que nous pensons déjà connaître qui nous empêche souvent d’apprendre. (Claude Bernard)

13/08/2015, 22h32
aziz1015

Citation:

Envoyé par Marc-L

[INDENT]

Si évidemment la colonne A doit rester en l'état, je reviendrais avec un dictionnaire sans Find …
[COLOR=#d3d3d3]

Le nouvel état de la colonne A ne me pose aucun problème ! Mais, comme je vous le disais tout à l'heure, lorsque j'essaie d'appliquer la macro sur le fichier complet (plus de 130 000 lignes), la macro a mis 1h de temps pour ne parcourir que 7000/130 0000 lignes tout au plus (je le sais parce que j'ai fait Ctrl+Pause quand j'en avais marre d'attendre) !

J'ai un gros problème de temps d'exécution !

Merci pour votre aide
13/08/2015, 22h56
clementmarcotte

Citation:

Envoyé par aziz1015

J'ai un gros problème de temps d'exécution !

Merci pour votre aide

Tu vas devoir admettre que tu as créé un monstre avec un programme qui n'est pas adapté pour maîtriser des monstres. Tu dois accepter les contraintes de ton monstre ou migrer vers un vrai SGBD. Honnêtement, je suis surpris que tu aies encore des réponses.

Je persiste et signe avec tout ce que t'ai dit là.

http://www.developpez.net/forums/d15...a/#post8347612

Avec l'ajout que de travailler directement sur la feuille est encore plus lent que de travailler avec des tableaux.

bonjour,

Je ne peux que plussoyer à l'ensemble des réponses formulées..

néanmoins, on peut ( en se passant du find -c'était pas une si bonne idée comme dis plus haut) faire comme ça:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Dim Dico, C As Range, K Dim DicoAddress Set Dico = CreateObject("Scripting.Dictionary") Set DicoAddress = CreateObject("Scripting.Dictionary") For Each C In Range(Cells(2, 1), Cells(200000, 1).End(xlUp)) If Not Dico.Exists(C.Value) Then Dico.Add C.Value, "" DicoAddress.Add C.Value, C.Offset(0, 10).Address End If Dico.Item(C.Value) = Dico.Item(C.Value) & " " & C.Offset(0, 1) Next C For Each K In Dico.Keys Range(DicoAddress.Item(K)) = Dico.Item(K) Next K
ça devrais être assez rapide je pense même pour plus de 100 000 enregistrement.
et définitivement, arretez de vouloir faire passer excel pour un gestionnaire de base de données... c'est pas fait pour!

Voir 40 message(s) de cette discussion en une page