Discussion :

[Daranc]

Bonjour
après plusieurs recherches (et questions) sur le forum je suis arrivé à finaliser mon utilitaire
la demande:
j'ai une feuille client
depuis un USF je pointe une date, la date est soit recalculée à partir de la date du jour soit à partir de la date saisie de façon à être de ce format:01-mois-année

Code :

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

1
2
3
4
5
6
7
8
9
10
'------------- 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 ---------------------------

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)

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
'--------------- 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 5 Step -1
If .Cells(i, 1) <= rep Then
FinTaC = i
Exit For
End If
Next
TableauC = .Range("a" & DebTaC & ":b" & FinTaC)
 
For lin = 0 To FinTaC - DebTaC
ReDim Preserve TabL(0 To FinTaC - DebTaC)
TabL(lin) = .Cells(lin + DebTaC, 2)
Next lin
End With

je le pose sur une feuille "temp" pour filtrer les nom des clients (ouskel'n'or)
et ré-alimente le tableau liste client (tabloC)
ici j'ai refait le tri en me servant d'un tableau mémoire

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
'ordonnancement des noms--------------------
For num = 0 To UBound(TabL) - 1
For num2 = num + 1 To UBound(TabL)
If TabL(num) > TabL(num2) Then
old = TabL(num)
old2 = TabL(num2)
TabL(num) = old2
TabL(num2) = old
End If
Next num2
If num <> 0 Then
If TabL(num) = TabL(num - 1) Then GoTo suite
End If
suite:
Next num
'fin de tri alphabétique----------

j'élimine les doublons

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
e = 0
For t = 0 To UBound(TabL)
ReDim Preserve TableC(e)
If e <> 0 Then                   'si les element qui se suivent sont différents
    If TableC(e - 1) <> TabL(t) Then
    TableC(e) = TabL(t)
    e = e + 1
    End If
Else
    TableC(0) = TabL(t)   'ceci donne le premier élément               
    e = e + 1
End If
Next

je crée mon tableau récapitulatif avec plusieurs boucles je compte le nombre d'apparition par mois de ce nom

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
For t = 0 To UBound(TableC)
ReDim Preserve TabL(0 To UBound(TableC), 0 To 13)
TabL(t, 0) = TableC(t)
Next
For t = 0 To UBound(TableC)
For x = 1 To UBound(TableauC, 1)
ReDim Preserve TabL(0 To UBound(TableC), 13)
If TabL(t, 0) = TableauC(x, 2) Then
nb = nb + 1
End If
Next
TabL(t, 1) = nb
nb = 0
Next
nb = 0
Mois = -11
For i = 2 To 13
For t = 0 To UBound(TableC)
For x = 1 To UBound(TableauC, 1)
ReDim Preserve TabL(0 To UBound(TableC), i)
If TableC(t) = TableauC(x, 2) Then
If DateAdd("m", Mois, rep) = TableauC(x, 1) Then
nb = nb + 1
End If
End If
Next
TabL(t, i) = nb
nb = 0
Next
Mois = Mois + 1
Next

ici je posais le tableau sur la feuille et le triais en fonction du total annuel tableC(x,1) mais j'ai remplacé cette opération par un tri VBA

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
'-------insertion du tri numerique sur total -------
For num = 0 To UBound(TabL) - 1
Dim permute(0 To 1, 0 To 13)
For num2 = num + 1 To UBound(TabL)
If TabL(num, 1) < TabL(num2, 1) Then
For t = 0 To 13 ' une boucle pour que tous les champs soient déplacés
permute(0, t) = TabL(num, t)
Next
For t = 0 To 13
permute(1, t) = TabL(num2, t)
Next
For t = 0 To 13
TabL(num, t) = permute(1, t)
Next
For t = 0 To 13
TabL(num2, t) = permute(0, t)
Next
End If
Next num2
If num <> 0 Then
If TabL(num, 1) = TabL(num - 1, 1) Then GoTo suite3
End If
suite3:
Next num

et je pose le tableau fini sur la feuille

Code :

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

1
2
3
4
5
6
7
'---------terminaison tri numérique annuel -------
With Sheets("recap")                   'la ligne de titre est en ligne 1
.Unprotect Password:="Passe feuille"   'deprotection feuille
.Range("a2:ad65535").ClearContents     'zone d'écriture pour 2 tableaux
.range("n1").value= rep   'ceci permet le calcul des entêtes en fonction de la date de recherche
.Range("a2:n" & UBound(TableC) + 2).Value = TabL 'pose premier tableaux
End With

pour passer au deuxième tableau, j'emploie exactement la même macro à partir de "Créations des tableaux clients" seul change le nom de la feuille juste avant je vide les tableaux par :

Code :

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

1
2
3
Erase TableauC
Erase TableC
Erase TabL

après m'être bien pris la tête sur ce problème je met la solution trouvée ici ce qui pourra servir à d'autre
Merci à SilkiRoad pour ces tutos , à ouskel'n'or pour ces astuces et à tous les autres qui mont aidés, orientés pour élaborer cette macro

[Daranc]

pour le tri une simplification

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
1
'-------insertion du tri numerique sur total -------
For num = 0 To UBound(TabL) - 1
Dim permute(0 To 1, 0 To 13)
For num2 = num + 1 To UBound(TabL)
If TabL(num, 1) < TabL(num2, 1) Then
For t = 0 To 13 ' une boucle pour que tous les champs soient déplacés
'__________________ modification 1 seule boucle au lieu de 4__________
permute(0, t) = TabL(num, t)
permute(1, t) = TabL(num2, t)
TabL(num, t) = permute(1, t)
TabL(num2, t) = permute(0, t)
Next
End If
Next num2
If num <> 0 Then
If TabL(num, 1) = TabL(num - 1, 1) Then GoTo suite3
End If
suite3:
Next num

la remarque m'a été faite par un collègue de travail (aux prise avec un tri à effectué sur un tableau)