Discussion :

[mido21]

Bonsoir
Je veux migrer des données de papier "data"
Il y a trois colonnes, la première colonne "d" _Son nom est "kind"
Il y a trois colonnes, la première colonne "b" _Son nom est "group"
Il y a trois colonnes, la première colonne "c" _Son nom est "name"
Je veux la méthode de migration de données
Données de la colonne D ' et la colonne correspondante « b », etc..
Un exemple en pièces jointes

mido.xlsm

[Nicolas JACQUIN]

https://www.developpez.net/forums/d8...s-discussions/

[78chris]

Bonjour

Cela s'appelle un tableau croisé dynamique pas une migration.

Regarde les didacticiels sur les tableaux croisés dynamiques.

Il te faut

• placer les champs Kind, Group, Name, en étiquette de ligne et le 4ème champ en valeurs,
• choisir la disposition plan
• choisir le placement des sous-totaux en bas de groupe

[mido21]

Bonsoir 78chris

Je suis bien avec les tableaux "pivot table"
Mais je veux le code de la solution

[RyuAutodidacte]

bonsoir,

dans ce cas si tu as pu le faire manuellement, tu pourras générer une base de code à l'aide de l'enregistreur de macro qui te donnera les prémices de la solution :
voir ce lien => http://fauconnier.developpez.com/tut...istreur-macro/

[clementmarcotte]

Bonsoir 78chris

Je suis bien avec les tableaux "pivot table"
Mais je veux le code de la solution

Tu risques d'attendre longtemps. Le forum n'est pas là pour fournir du code gratuit et clef en main

Nous ne sommes pas là pour faire vos exercices.

[mido21]

Bonsoir à tous les Forum
Je sais que le Forum ne pas fournir des solutions complètes et télécharger
Mais la seule fois disponible, assistance
Je vous remercie pour les réponses
Je pourrais essayer d’écrire le code et s’il vous plaît corriger le code

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
Sub kind()
Range("b5:d10000").Clear
 
With sheet3
    On Error Resume Next
    Dim collon_d As Collection, dd As Range
    Dim collon_b As Collection, bb As Range
    Dim collon_c As Collection, cc As Range
    ''''''''''''''''''''''''''''''''''''''''''
        Set collon_d = New Collection
        Set collon_b = New Collection
        Set collon_c = New Collection
        '''''''''''''''''''''''''''''''''''''''''''''''''
         LsRow = .Range("d" & Rows.Count).End(xlUp).Row
         For Each dd In .Range("d4:d" & LsRow)
          collon_d.Add dd.Value, dd.Text
           Next dd
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
           LsRow1 = .Range("b" & Rows.Count).End(xlUp).Row
           For Each bb In .Range("b4:b" & LsRow1)
              collon_b.Add bb.Value, bb.Text
            Next bb
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          LsRow2 = .Range("c" & Rows.Count).End(xlUp).Row
           For Each cc In .Range("c4:c" & LsRow2)
              collon_c.Add cc.Value, cc.Text
            Next cc
  '''''''''''''''''''''''''''''''''''''''''''''''''''
        g = 5
        For i = 1 To collon_b.Count
         sheet5.Cells(g + collon_b.Count, 2) = CStr(collon_d(i))
         sheet5.Cells(g + collon_d.Count, 3) = CStr(collon_b(i))
         sheet5.Cells(g + collon_c.Count, 4) = CStr(collon_c(i))
             g = g + 1
 
        Next i
   End With
End Sub

[mido21]

Bonsoir
S’il vous plaît m’aider à mettre le code suivant
Le code fonctionne correctement

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
Sub kind()
Range("b2:d10000").Clear
g = 2
With sheet3
    On Error Resume Next
    Dim collon_d As Collection, dd As Range
    Dim collon_b As Collection, bb As Range
    Dim collon_c As Collection, cc As Range
    ''''''''''''''''''''''''''''''''''''''''''
        Set collon_d = New Collection
        Set collon_b = New Collection
        Set collon_c = New Collection
        '''''''''''''''''''''''''''''''''''''''''''''''''
         LsRow2 = .Range("d" & Rows.Count).End(xlUp).Row
         For Each dd In .Range("d4:d" & LsRow2)
          collon_d.Add dd.Value, dd.Text
           Next dd
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
           LsRow = .Range("b" & Rows.Count).End(xlUp).Row
           For Each bb In .Range("b4:b" & LsRow)
              collon_b.Add bb.Value, bb.Text
            Next bb
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          LsRow = .Range("c" & Rows.Count).End(xlUp).Row
           For Each cc In .Range("c4:c" & LsRow)
              collon_c.Add cc.Value, cc.Text
            Next cc
  '''''''''''''''''''''''''''''''''''''''''''''''''''
     For i = 1 To collon_d.Count
     sheet4.Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Value = collon_d(i)
       '---------------------------------------------------------------
       For g = 1 To collon_c.Count
        If CStr(sheet3.Cells(g + 4, 4).Text) = CStr(collon_d(i)) Then
         sheet4.Range("d" & Rows.Count).End(xlUp).Offset(collon_d.Count, 0).Value = CStr(collon_c(g))
          End If
          '----------------------------------
          For f = 1 To collon_b.Count
        If CStr(sheet3.Cells(f + 4, 3).Text) = CStr(collon_c(g)) Then
         sheet4.Range("c" & Rows.Count).End(xlUp).Offset(collon_c.Count, 0).Value = CStr(collon_b(f))
       End If
          Next
            Next
             Next
   End With
End Sub