Discussion :

[aziz1015]

Bonjour,

J'ai du mal à adapter ce code fait par Tauthème pour créer une clé avec deux colonnes ! Le but étant juste de regrouper les éléments ayant les mêmes occurrences pour chaque cellule des deux colonnes et les séparer à chaque fois de deux lignes ! La première colonne contient des string et l'autre des valeurs concaténées avec des Astérix à l'intérieur de la chaîne !

J'ai un problème lorsque je lance le code, on me dit incompatibilité de type, je pense que je l'ai mal modifié vu qu'à la base, il était utilisé pour créer une clé sur trois colonnes !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private OS As Worksheet 'déclare la variable OS (Onglet Source)
Private OD As Worksheet 'déclare la variable OD (Onglet Destination)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private NL As Long 'déclare la variable NL (Nombre de Lignes)
Private NC As Integer 'déclare la variable NC (Nombre de Colonnes)
 
Sub Macro1()
Dim D As Object 'déclare la variable ND (Dictionnaire)
Dim CC As String 'déclare la variable CC (Concaténation de Colonnes)
Dim TL() As Variant 'déclare la variable TL (Tableai de Lignes)
Dim I As Long 'déclare la variable I (Incrément de lignes)
Dim J As Integer 'déclare la variable J (incrément de lignes)
Dim K As Long 'déclare la variable K (incrément de lignes)
Dim L As Integer 'déclare la variable L (incrément de colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set OS = ThisWorkbook.Sheets("Feuil2") 'définit l'onglet source OS (à adapter)
Set OD = ThisWorkbook.Sheets("Feuil3") 'définit l'onglet destination OD (à adapter)
TC = OS.Range("A1").CurrentRegion 'définit le tableau de cellules TC (à adapter)
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellulles TC
NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellulles TC
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionaire D
For I = 2 To NL 'boucle sur toutes les ligne du tableau de cellues TC (en partant de la seconde)
    'définit la concaténation CC
    'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
    CC = CStr(TC(I, 3)) & CStr(TC(I, 6)) '& CStr(TC(I, 3)) c'est ici que je modifie le code
    D(CC) = D(CC) + 1 'alimente le dictionnaire avec le concaténation CC
Next I 'prichaine ligne de la boucle
TE = D.keys 'récupère tableau TE (Tableau des Éléments) les éléments du dictionnaire D sabs doiblon
TOC = D.items 'récupère tableau TOC (Tableau des OCcurrences) le nombre d'occurrence de chaque élément de TE
For I = LBound(TE) To UBound(TE) 'boucle sur tous les éléments de TE
    If TOC(I) > 1 Then 'condition 1 : si l'élément a plusieurs occurrences
        K = 1 'initialise la variable K
        For J = 2 To NL 'boucle 1 sur toutes les lignes J du tableau de cellules TC (en partant de la seconde)
            'condition 2 : si la concaténation des colonne 1 deux et trois est égale à TE(I)
            'remplace 1, 2 et 3 par le numero des colonnec contenant le "Code Clien", le "Libellé" et le "Prix"
            'If CStr(TC(J, 1)) & CStr(TC(J, 2)) & CStr(TC(J, 3)) = TE(I) Then c'est normalement cette ligne de code qui était utilisée
            If CStr(TC(J, 3)) & CStr(TC(J, 6)) = TE(I) Then 'ici ma modification pour avoir que deux colonnes
                'redimensionne le tableau de lignes TL (autant de ligne que TC a de colonnes,K colonnes)
                ReDim Preserve TL(1 To NC, 1 To K)
                For L = 1 To NC 'boucle 2 : sur toutes les colonnes de TC
                    TL(L, K) = TC(J, L) 'récupère dans la ligne de TL la valeur de la colonne de TC (transposition)
                Next L 'prochaine colonne de la boujcle 2
                K = K + 1 'incrémente K
            End If 'fin de la condition 2
        Next J 'prochaien ligne de la boucle 1
        If K > 1 Then 'condition 3 : si K est supérieur à 1 (au moins une occurrence trouvée)
            'définit la cellue de destination DEST
            Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(3, 0))
            'revoie dans DEST redinensionnée le tableau TL transposé
            DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'erreur se trouve su cette ligne (Incompatibilité de type)
        End If 'fin de la condition 3
        Erase TL 'vide le tableau TL
    End If 'fin de la condition 1
Next I 'prochain élément du tableau TE
End Sub

Merci pour votre aide

[Daniel.C]

Bonjour,

Si l'erreur se produit sur une ligne précise (surlignée en jaune, quelle est-elle ? Sinon, exécute la macro ligne à ligne, en mémorisant bien la dernière ligne exécutée. Lorsque l'erreur se produit, tu es capable de dire la ligne fautive.

[aziz1015]

Bonjour,

j'avais précisé dans le code de ma publication ! Peut être n'avez vous pas pu lire !

L'erreur se trouve au niveau de la ligne 53 (Incompatibilité de type) !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'erreur se trouve su cette ligne (Incompatibilité de type)

Merci pour votre aide

[Daniel.C]

C'est le ".value" qui est en trop. Mets :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DEST.Resize(UBound(TL, 2), UBound(TL, 1)) = Application.Transpose(TL)

Et la prochaine fois, tu dis : "l'erreur se produit sur la ligne 53".

[Marc-L]

Bonjour !

C'est le ".value" qui est en trop

S'il est d'un côté, c'est bien de l'ajouter aussi de l'autre …

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[Daniel.C]

Bonjour,

S'il est d'un côté, c'est bien de l'ajouter aussi de l'autre …

Mais, s'il n'est pas de l'autre, il faut bien le retrancher de celui-ci...

Euh tu ajouterais la propriété Value à la fonction Transpose ? Osé