macro vba TCD formulaire

nina7121987

XLDnaute Nouveau
bonjour,

Voila mon probleme j'ai creer un formulaire qui crée un TCD qui represente les données(c'est à dire le nombre de deplacements) filtrer par quatre criteres selon plusieurs variables. Pour l'instant ma macro cree quatre liste pour ajouter quatre variables à mon tcd.

Ce que je voudrais c'est generaliser mon programme afin de pouvoir creer une seule liste puisqu'elle sont identique seule le choix de variables differe et de rajouter autant de variables que l'on veut au tcd.

Aidez stp merci, si besoin est je peux mettre le programme de depart que j'ai ecrit
 

nina7121987

XLDnaute Nouveau
Re : macro vba TCD formulaire

voila mon programme mais je sais pas si ca va etre plus clair!

Private Sub valider_Click()
Dim secO As Integer
Dim secD As Integer
Dim zonD As Integer
Dim zonO As Integer
Dim var1 As String
Dim var2 As String
Dim var3 As String
Dim var4 As String
secO = Me.ListsecO.Value 'affectation des valeurs des lstes aux variables correspondantes
secD = Me.ListsecD.Value
zonD = Me.ListzonD.Value
zonO = Me.ListzonO.Value
Dim i As Integer
Dim f As Worksheet
Set f = Worksheets("TCD")
MsgBox ("vous avez choisi le secteur d'origine " & secO & "de zone" & zonO & " à destination du secteur " & secD & "de zone" & zonD)
'creation du tableau croisé dynamique
Sheets("Données").Select
Cells.Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Données!A1:IS14986").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=f.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select

If listVariable1.Value <> "" Then
var1 = Me.listVariable1.Value
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields(var1)
.Orientation = xlRowField
.Position = 1
End With
End If


If Listvar3.Value <> "" Then
var3 = Me.Listvar3.Value
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields(var3)
.Orientation = xlRowField
.Position = 2
End With
End If


If listvariable2.Value <> "" Then
var2 = Me.listvariable2.Value
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields(var2)
.Orientation = xlColumnField
.Position = 1
End With
End If

If Listvar4.Value <> "" Then
var4 = Me.Listvar4.Value
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields(var4)
.Orientation = xlColumnField
.Position = 2
End With
End If

ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Nombre_deplacements"), _
"Nombre de deplacement", xlCount

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Nombre de deplacement")
.Calculation = xlPercentOfTotal
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_secteur origine deplacement corrigé")
.Orientation = xlPageField
.Position = 1
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_secteur destination deplacement corrigé")
.Orientation = xlPageField
.Position = 2
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_zone fine origine deplacement corrigée")
.Orientation = xlPageField
.Position = 2
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_zone fine destination deplacement corrigée")
.Orientation = xlPageField
.Position = 2
End With

ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_secteur destination deplacement corrigé").CurrentPage = secD
ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_secteur origine deplacement corrigé").CurrentPage = secO
ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_zone fine destination deplacement corrigée").CurrentPage = zonD
ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"DEP_zone fine origine deplacement corrigée").CurrentPage = zonO

ActiveWorkbook.ShowPivotTableFieldList = False

Cells.Select
Selection.ColumnWidth = 3 'format largeur des colonnes
End Sub
'permet lorsque l'utilisateur clique sur le bouton ANNULER, les données contenues
'dans le formulaire soient effacées sans traitement et que le formulaire soit fermé.
Private Sub Annuler_Click()
Hide
Accueil1.Show
End Sub

Private Sub UserForm_Initialize()
Sheets("Liste").Select
'création de la zone de liste secteur destination
Dim lig As Integer
Dim ColC As String
Dim ValeurCouranteC As String
Dim ValeurPrécédenteC As String

lig = 2
ColC = "C"
ValeurPrécédenteC = ""
ValeurCouranteC = Cells(lig, ColC).Value
Do While ValeurCouranteC <> ""
If ValeurCouranteC <> ValeurPrécédenteC Then
ListsecD.AddItem ValeurCouranteC
End If
lig = lig + 1
ValeurPrécédenteC = ValeurCouranteC
ValeurCouranteC = Cells(lig, ColC).Value
Loop



Dim ligD As Integer
Dim ColD As String
Dim ValeurCouranteD As String
Dim ValeurPrécédenteD As String

ligD = 2
ColD = "D"
ValeurPrécédenteD = ""
ValeurCouranteD = Cells(ligD, ColD).Value
Do While ValeurCouranteD <> ""
If ValeurCouranteD <> ValeurPrécédenteD Then
ListzonD.AddItem ValeurCouranteD
End If
ligD = ligD + 1
ValeurPrécédenteD = ValeurCouranteD
ValeurCouranteD = Cells(ligD, ColD).Value
Loop

'création de la zone de liste secteur origine
Dim ligA As Integer
Dim ColA As String
Dim ValeurCouranteA As String
Dim ValeurPrécédenteA As String

ligA = 2
ColA = "A"
ValeurPrécédenteA = ""
ValeurCouranteA = Cells(ligA, ColA).Value
Do While ValeurCouranteA <> ""
If ValeurCouranteA <> ValeurPrécédenteA Then
ListsecO.AddItem ValeurCouranteA
End If
ligA = ligA + 1
ValeurPrécédenteA = ValeurCouranteA
ValeurCouranteA = Cells(ligA, ColA).Value
Loop


Dim ligB As Integer
Dim ColB As String
Dim ValeurCouranteB As String
Dim ValeurPrécédenteB As String

ligB = 2
ColB = "B"
ValeurPrécédenteB = ""
ValeurCouranteB = Cells(ligB, ColB).Value
Do While ValeurCouranteB <> ""
If ValeurCouranteB <> ValeurPrécédenteB Then
ListzonO.AddItem ValeurCouranteB
End If
ligB = ligB + 1
ValeurPrécédenteB = ValeurCouranteB
ValeurCouranteB = Cells(ligB, ColB).Value
Loop

Sheets("Données").Select

'creation de la zone de liste de la 1ere variable
Dim Lig1 As Integer
Dim Col1 As Integer
Dim ValeurCourante1 As String
Dim ValeurPrécédente1 As String

Lig1 = 1
Col1 = 1
ValeurPrécédente1 = ""
ValeurCourante1 = Cells(Lig1, Col1).Value
Do While ValeurCourante1 <> ""
If ValeurCourante1 <> ValeurPrécédente1 Then
listVariable1.AddItem ValeurCourante1
End If
Col1 = Col1 + 1
ValeurPrécédente1 = ValeurCourante1
ValeurCourante1 = Cells(Lig1, Col1).Value
Loop

'creation de la zone de liste de la 2eme variable
Dim Lig2 As Integer
Dim Col2 As Integer
Dim ValeurCourante2 As String
Dim ValeurPrécédente2 As String

Lig2 = 1
Col2 = 1
ValeurCourante2 = Cells(Lig2, Col2).Value
Do While ValeurCourante2 <> ""
If ValeurCourante2 <> ValeurPrécédente2 Then
listvariable2.AddItem ValeurCourante2
End If
Col2 = Col2 + 1
ValeurPrécédente2 = ValeurCourante2
ValeurCourante2 = Cells(Lig2, Col2).Value
Loop


'creation de la zone de liste de la 3eme variable
Dim Lig3 As Integer
Dim Col3 As Integer
Dim ValeurCourante3 As String
Dim ValeurPrécédente3 As String

Lig3 = 1
Col3 = 1
ValeurCourante3 = Cells(Lig3, Col3).Value
Do While ValeurCourante3 <> ""
If ValeurCourante3 <> ValeurPrécédente3 Then
Listvar3.AddItem ValeurCourante3
End If
Col3 = Col3 + 1
ValeurPrécédente3 = ValeurCourante3
ValeurCourante3 = Cells(Lig3, Col3).Value
Loop

'creation de la zone de liste de la 4eme variable
Dim Lig4 As Integer
Dim Col4 As Integer
Dim ValeurCourante4 As String
Dim ValeurPrécédente4 As String

Lig4 = 1
Col4 = 1
ValeurCourante4 = Cells(Lig4, Col4).Value
Do While ValeurCourante4 <> ""
If ValeurCourante4 <> ValeurPrécédente4 Then
Listvar4.AddItem ValeurCourante4
End If
Col4 = Col4 + 1
ValeurPrécédente4 = ValeurCourante4
ValeurCourante4 = Cells(Lig4, Col4).Value
Loop
End Sub
 

tototiti2008

XLDnaute Barbatruc
Re : macro vba TCD formulaire

Euh... pour être franc, je ne sais pas trop par quel bout le prendre.
Le code c'est bien mais je suis un peu étranger au concept général.
Pourquoi as-tu plusieurs listes sur plusieurs feuilles ?
Y as t-il un nombre maximum de variables pour ton TCD ?
Ne peux-tu pas joindre un bout de fichier ?
 

nina7121987

XLDnaute Nouveau
Re : macro vba TCD formulaire

Tout d'abord pour repondre a tes questions j'ai plusieurs feuille pour mes listes car j'ai quatre liste qui correspondent à des numero de secteur et de zones donc pour trier mes colonnes par odre croissant je l'ai mises dans une autre feuille je savais pas faire autrement et pour les autres les listes sont creer à partir de la feuille de données avec les libelles de variable voila
aparement mon fichier depasse la taille maximale pour ce forum il faut dire que j'ai 250 variables donc je sais pas comment faire
 

Discussions similaires

Réponses
6
Affichages
2 K
B
Réponses
2
Affichages
1 K
born2mars
B

Statistiques des forums

Discussions
312 017
Messages
2 084 655
Membres
102 628
dernier inscrit
alexduf971