Discussion :

[kedmard]

Bonjour,

Merci d'avance de m'orienter vers un sujet similaire s'il existe, car je n'en ai pas trouvé.

Autrement, mon souci est le suivant, je souhaiterai alimenter le tableau de la feuille "RECAP" du classeur ci-joint
avec une formule interactive basée sur chacun des tableau croisé dynamique et ce via une macro VBA.
Par exemple en F3 de ma feuille "RECAP", je veux avoir le coût totale des transferts de 2022
et H5 l'âge totale de 2024.

Voici le code que j'ai écrit, qui malheureusement ne produit aucun changement sur ma feuille "RECAP"

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
 
 
Sub MacTest(SCOPE As Variant)
Dim NL, r, j, k As Integer
 
Dim CurrentWb As Excel.Workbook
Set CurrentWb = ThisWorkbook
 
 
Set SheetRCP = CurrentWb.Worksheets("RECAP")
Set SheetTCD = CurrentWb.Worksheets("TCD_" & SCOPE)
 
For r = 1 To Worksheets.Count
  If (Worksheets(r).Name = "TCD_" & SCOPE) Then
    For i = 2 To LastrCP
      If InStr(1, SheetTCD.Cells(6, 1), SheetRCP.Cells(i, 5), SCOPE) > 0 Then
        For k = 2 To LastcTC
        NL = SheetRCP.Cells(i, 5).Row
        If (Trim(SheetTCD.Cells(5, k).Value) = Trim(SheetRCP.Cells(i - NL, k + 4).Value)) Then
            SheetRCP.Activate
            Activatesheet.Cells(i, k + 4).Select
            ActiveCell.FormulaR1C1 = "=GETPIVOTDATA("" & SCOPE & "",'[ & ""TCD_"" & SCOPE & ]'!R4C1,""DT_ARRI"",Trim(Activatesheet.Cells(i - NL, k + 4).Value))"
        End If
        Next k
      End If
    Next i
 
 
  End If
Next r
End Sub

Toute aide serait la bienvenue.

Merci d'avance.

[78chris]

Bonjour

De simples formules à base de LIREDONNEESTABCROISDYNAMIQUE suffisent...

Si tu tiens à l'avoir en VBA utilise l’enregistreur et valide une des formules afin d'avoir la bonne syntaxe

Où est défini LastrCP ?

[kedmard]

Salut 78chris,

Merci pour l'attention apportée à mon souci.
Je veux absolument utiliser du code car mes TCD seront régulièrement mis à jour.
C'est justement l'enregistreur qui m'a inspiré à écrire mon code, mais je ne parviens pas à le réadapter de sorte
à mon servir comme je l'entends. Je continue à chercher.

En tout cas merci quand même.

[kedmard]

Bonjour,

J'ai finalement réussi à concocter quelque chose qui marche,(j'ai dû pour cela renommer mon champ "COUT_TRANS" en "COUT").
Ce n'est pas le court des codes mais il fait l'affaire :

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
 
 
 
Sub MacTest()
Dim r, j, k As Integer
Dim SCOPE
 
Dim CurrentWb As Excel.Workbook
Dim SheetRCP As Excel.Worksheet
Dim SheetTCD As Excel.Worksheet
 
Dim Mchstr, Chv As String
Dim LastrCP, LastcCP, LastcTC, LastrTC As Long
 
Set CurrentWb = ThisWorkbook
Set SheetRCP = CurrentWb.Worksheets("RECAP")
 
LastrCP = SheetRCP.Range("E" & SheetRCP.Rows.Count).End(xlUp).Row
LastcCP = SheetRCP.Cells(2, SheetRCP.Columns.Count).End(xlToLeft).Column
 
For Each cell In Range(SheetRCP.Cells(3, 5), SheetRCP.Cells(5, 5))
SCOPE = cell.Value
 
Set SheetTCD = CurrentWb.Worksheets("TCD_" & SCOPE)
LastrTC = SheetTCD.Range("A" & SheetTCD.Rows.Count).End(xlUp).Row
LastcTC = SheetTCD.Cells(5, SheetTCD.Columns.Count).End(xlToLeft).Column
 
For r = 1 To Worksheets.Count
  If (Worksheets(r).Name = "TCD_" & SCOPE) Then
    For i = 2 To LastrCP
      If (InStr(1, Trim(SheetTCD.Cells(6, 1).Value), SCOPE) > 0 And InStr(1, Trim(SheetRCP.Cells(i, 5).Value), SCOPE) > 0) Then
        For k = 2 To LastcTC
        If (Trim(SheetTCD.Cells(5, k).Value) = Trim(SheetRCP.Cells(2, k + 4).Value)) Then
           Mchstr = "=GETPIVOTDATA("
           Mchstr = Mchstr & """" & SCOPE & """"
           Mchstr = Mchstr & "," & "TCD_" & SCOPE & "!R4C1,"
           Mchstr = Mchstr & """" & "DT_ARRI" & """" & ","
           Mchstr = Mchstr & SheetRCP.Cells(2, k + 4).Value & ")"
           Chv = Mchstr
 
           SheetRCP.Cells(i, k + 4) = Chv
        End If
        Next k
      End If
    Next i
  End If
Next r
 
Next cell
End Sub

Bon weekend,

Kedmard