tableau en VBA

Version imprimable

tableau en VBA

Bonjour
j'ai voulu, à l'aide des tutos de SilkyRoad, amélioré et accéléré le code que j'ai obtenu ici
pour l'avoir accéléré on peut dire que ça marche .. pour ce qui est du résultat ça marche pas

donc je reprends
j'ai une feuille client
depuis un USF je pointe une date la date est soit recalculé a partir de la date du jour soit à partir de la date saisie de façon à être de ce format:01-mois-année
puis je pointe la feuille de sorte à extraire une plage comprise entre la date calculée est la date calculée - 12 mois
je prends les deux premières colonnes du tableaux (colonne 1 date colonne2 nom client)
je le pose sur une feuille "temp" pour filtrer les nom des clients (ouskel'n'or)
et ré-alimente le tableau liste client (tabloC)
puis avec plusieurs boucles je compte le nombre d'apparition par mois de ce nom
(et c'est ici que ça merde ) j'obtiens une magnifique tapisserie de #NA
et je ne trouve pas ou ça coince

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
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Application.ScreenUpdating = False
Dim e As Integer
Dim rep As Date
Dim fin As Integer
Dim i As Long
Dim TableauC As Variant
Dim tabloC As Variant
Dim TableC() As Variant
Dim t As Integer
 
'------------- Limite de dates 12 mois glissants -----------------
If TextBox1.Value = "" Then
    rep = CDate(Date)
  Else
    rep = CDate(TextBox1)
End If
TextBox1.Value = DateSerial(Year(rep), Month(rep), 1)
rep = TextBox1.Value
deb = DateSerial(Year(rep), (Month(rep)) - 12, 1)
'------------------ Fin de limite dates --------------------------
 
'--------------- Créations des tableaux clients ------------------
With Sheets("nc_client")
    fin = .Range("a65535").End(xlUp).Row
    For i = 5 To fin
        If .Cells(i, 1).Value >= deb Then
            DebTaC = i
            Exit For
        End If
    Next
    For i = fin To 4 Step -1
        If .Cells(i, 1) <= rep Then
            FinTaC = i
            Exit For
        End If
    Next
    TableauC = .Range("a" & DebTaC & ":b" & FinTaC)
    tabloC = .Range("b" & DebTaC & ":b" & FinTaC)
End With
'----------- Fin de Créations des tableaux clients --------------
 
'------- Filtrage des clients ---- Ouskel'n'or ------------------
With Sheets("temp")
    .Range("a:a").ClearContents
    .Range("a1:a" & FinTaC - DebTaC + 1).Value = tabloC
    .Range("a1:a" & FinTaC - DebTaC + 1).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("B1:b" & FinTaC - DebTaC + 1), Unique:=True
    Set Plage = .Range("a1:a" & FinTaC - DebTaC + 1).SpecialCells(xlCellTypeVisible)
    Erase tabloC
t = 0
    For Each Cell In Plage
        ReDim Preserve tabloC(t)
        tabloC(t) = Cell
        t = t + 1
    Next
    .ShowAllData
End With
'-------- Fin de filtrage et remaniment du tableau liste --------
 
'---------------- creation du tabeau de feuille -----------------
For t = 0 To UBound(tabloC)
    ReDim Preserve TableC(UBound(tabloC), 0)
    TableC(t, 0) = tabloC(t)
    For i = 14 To 1 Step -1
        For x = 1 To UBound(TableauC, 1)
            ReDim Preserve TableC(UBound(tabloC), i)
            If TableC(t, 0) = TableauC(x, 2) And DateAdd("m", (-i + 2), rep) = TableauC(x, 1) Then
                nb = nb + 1
            End If
            TableC(t, i) = nb
        Next
        nb = 0
    Next
Next
With Sheets("temp")
    .Range("a:n").ClearContents
    .Range("a1:n" & UBound(tabloC) + 1).Value = TableC
End With
 
 
Unload Me
End Sub

si quelqu'un peut m'expliquer ou je foire?

bien n'en n'étant pas à une conn... près j'ai corrigé une petite erreur
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 For t = 0 To UBound(tabloC) ReDim Preserve TableC(UBound(tabloC), 13) TableC(t, 0) = tabloC(t) For i = 2 To 14 For x = 1 To UBound(TableauC, 1) ReDim Preserve TableC(UBound(tabloC), i) If tabloC(t) = TableauC(x, 2) Then If DateAdd("m", (-14 + i), rep) = TableauC(x, 1) Then nb = nb + 1 End If End If Next x TableC(t, i) = nb nb = 0 Next i Next t
qui consistait à prendre la borne du tableau à l'envers
maintenant je n'ai plus la tapisserie mais je n'ai toujours pas le résultat escompté a savoir j'ai bien ma colonne client conforme, et ma deuxième colonne vide (normale je ne la remplie pas;) ). j'ai ma troisième colonne remplie de chiffre et ma dernière ligne aussi tout le reste est vide:(

Citation:

je prends les deux premières colonnes du tableaux (colonne 1 date colonne2 nom client)
je le pose sur une feuille "temp" pour filtrer les nom des clients

Je reprends à partir d'ici. Je pense que jusque là ça "doit" fonctionner...
Ton filtre réalisé sur ta feuille temporaire, tu as une liste de tes clients sans doublon. (Tu me corriges si j'interprète mal)
Avec cette liste, si tu veux connaître le nombre de fois qu'apparaissent tes clients dans ta feuille de données, pourquoi ne pas utiliser Countif.
Tu passes la liste des clients en revue sur ta feuille Temp et tu comptes le nombre d'apparitions sur la feuille données avec un simple boucle
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub appel() 'à intégrer dans ta sub Dim FL1 as worksheet Dim FL2 as worksheet,i as integer, NbClients as integer Dim Plage As Range Set FL1 = Worksheets("Données") Set FL2 = Worksheets("Temp") Set Plage = FL1.Range("A1:A" & NbClients) 'Nombre de lignes dans ta feuille Temp For i = 1 to NbClients FL2.Cells(i,2) = Compte(Cells(i,1), Plage) Next End sub
Code:

1 2 3 Function Compte(NomClient as string, Plage as range) Compte = Application.WorksheetFunction.CountIf(Plage, NomClient) End Function
Citation:

si quelqu'un peut m'expliquer ou je foire?

Précisément, j'ai pas compris :aie:
Comme j'ignore ce que tu veux en faire, j'ai placé le résultat en feuille temp.
Ainsi tu obtiendras donc le nombre de fois qu'apparaissent les noms de tes clients dans la colonne 2.

... Si j'ai bien compris ta "problématique"...

Glory glory allleeeeelllouuia glory etc
bon j'ai finalement trouve le probleme
j'ai inversé la boucle t et i
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 For t = 0 To UBound(tabloC) ReDim Preserve TableC(0 To UBound(tabloC), 0 To 14) TableC(t, 0) = tabloC(t) Next nb = 0 For i = 2 To 14 For t = 0 To UBound(tabloC) For x = 1 To UBound(TableauC, 1) ReDim Preserve TableC(0 To UBound(tabloC), i) If tabloC(t) = TableauC(x, 2) Then If DateAdd("m", (-14 + i), rep) = TableauC(x, 1) Then nb = nb + 1 End If End If Next TableC(t, i) = nb nb = 0 Next Next
Merci à ceux qui m'ont aidé et à ceux qui m'ont lu
je met le code trouvé si ça peut dépanner quelqun