Pb macro TCD et rechercheV

A

Anthony_tey

XLDnaute Nouveau
Bonjour à tous.
Plantons le décor, je ne m'y connais pas du tout en VBA, et j'ai réalisé cette macro avec l'enregistreur de macro (ce qui explique certainement pour vous les 75% de contenu inutile :( )

Mon patron m'a demandé de réaliser cette macro afin de corriger et enrichir une base de donnée.

J'ai joins un fichier à titre d'exemple, vous pouvez coller la macro située en bas de ce message pour l'executer dans le fichier afin de mieu comprendre le résultat désiré.

Dans le fichier joint, vous pouvez voir sur ma feuille 1 la base de donnée que je dois corrigée, et enrichir avec un fichier RH qui est sur la feuille 2.

Tout d'abord, la base de donnée de la feuille 1 est toujours erronnée car elle contient des doublons. Donc dans un premier temps, je réalise un croisé dynamique (en supprimant les sous totaux de chaque colonne) afin d'avoir des données corrigée (au passage, j'interverti les 2 premieres colonnes) que je copie dans la feuille 3. Pour info, avant de copier coller, je change le format de la colonne A de la feuille 3 en texte car y seront insérés les matricules (nombre).

Ensuite avec ma base de donnée corigée sur la feuille 3 je vais l'enrichir avec la recherche V grace au doc RH situé sur la feuille 2. Pour enrichir, je le fais grace au matricule des personnes (d'ou la nécessité de faire passer mes matricules de la feuille 3 en texte, car le fichier RH de la feuille 2 est au format txt aussi mais il contient plus de 40000 noms donc je ne le convertis pas lui)

La macro est donc censée effectuer tout ça.

J'ai donc plusieurs problèmes.
tout d'abord vous pouvez voir dans la macro que j'ai modifié manuellement les selections de ligne (cela va de la L2 à la L50000) car l'enregistreur de macro ne prend en compte que la taille de la base de donnée lorsque j'enregistre la macro, or bien qu'on utilise des bases de données sous le meme format (meme nom de colonne et meme nombre) le nb de ligne varie tout le temps. Je ne sais pas comment faire pour que la macro auto selectionne le bon nb de ligne.

Ensuite étant donné la taille de la macro, elle met extremment longtemps à s'executer (essayez de l'executer pour ce fichier de 5 lignes ça vous fera rire) donc pour un fichier de 40000 lignes c'est une affaire de 20minutes quand ça fonctionne (car evidemment cela fait planter excel une fois sur )

Je n'ai pas inclus dans cet exemple le code basculant le calcul en manuel puis en automatique à la fin.

Ayant appris Excel de façon autodidacte, et n'étant pas expérimenté en ordinateur, j'arrive au bout de mes possibilités :( et n'arrive pas à faire mieu.
Donc je remercie par avance toute les personnes qui répondront, et meme celles qui ont fait l'effort de lire jusqu'au bout :p

PHP: 
Sub Exdemacro()
'
' Exdemacro Macro
' Macro enregistrée le 17/11/2009 par A6262489
'




    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Feuil1!R1C1:R50000C10").CreatePivotTable TableDestination:="", TableName:= _
        "Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("LoginId" _
        )
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "LoginId[All]" _
        , xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("LoginId"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Activity Name")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'Activity Name'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Activity Name").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Nom[All]", _
        xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Prénom")
        .Orientation = xlRowField
        .Position = 4
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Prénom[All]" _
        , xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Prénom"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "User Email")
        .Orientation = xlRowField
        .Position = 5
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'User Email'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("User Email"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "User Primary Organization")
        .Orientation = xlRowField
        .Position = 6
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'User Primary Organization'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "User Primary Organization").Subtotals = Array(False, False, False, False, False, _
        False, False, False, False, False, False, False)
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Completion Status")
        .Orientation = xlRowField
        .Position = 7
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'Completion Status'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Completion Status").Subtotals = Array(False, False, False, False, False, False, _
        False, False, False, False, False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Attempt Start Date")
        .Orientation = xlRowField
        .Position = 8
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'Attempt Start Date'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Attempt Start Date").Subtotals = Array(False, False, False, False, False, False, _
        False, False, False, False, False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Activity Completion Date")
        .Orientation = xlRowField
        .Position = 9
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'Activity Completion Date'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Activity Completion Date").Subtotals = Array(False, False, False, False, False, _
        False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Score Reel")
        .Orientation = xlRowField
        .Position = 10
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "'Score Reel'[All]", xlLabelOnly, True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Score Reel"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveWorkbook.ShowPivotTableFieldList = False
    Sheets("Feuil3").Select
    Columns("A:A").Select
    Selection.NumberFormat = "@"
    Sheets("Feuil4").Select
    Range("A4:J50000").Select
    Range("J5").Activate
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "données"
    Sheets("Feuil4").Select
    Sheets("Feuil4").Name = "TCD"
    Sheets("Feuil2").Select
    Sheets("Feuil2").Name = "PPS"
    Sheets("Feuil3").Select
    Sheets("Feuil3").Name = "Report"
    ActiveWindow.SmallScroll Down:=-3
    Range("K1").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Lib Niv1"
    Range("L1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Lib Niv2"
    Range("M1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Lib Niv3"
    Range("N1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Lib Niv4"
    Range("O1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Lib Niv5"
    Range("P1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "agence / dep"
    Range("Q1").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "Poste"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-10],PPS!C[-8]:C[25],6,FALSE)"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K50000")
    Range("K2:K50000").Select
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-11],PPS!C[-9]:C[24],8,FALSE)"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L50000")
    Range("L2:L50000").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-12],PPS!C[-10]:C[23],10,FALSE)"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M50000")
    Range("M2:M50000").Select
    ActiveWindow.ScrollColumn = 3
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-13],PPS!C[-11]:C[22],12,FALSE)"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N50000")
    Range("N2:N50000").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-14],PPS!C[-12]:C[21],14,FALSE)"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O50000")
    Range("O2:O50000").Select
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-15],PPS!C[-13]:C[20],16,FALSE)"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P50000")
    Range("P2:P50000").Select
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-16],PPS!C[-14]:C[19],18,FALSE)"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:Q50000")
    Range("Q2:Q50000").Select
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 591
    ActiveWindow.ScrollRow = 994
    ActiveWindow.ScrollRow = 1530
    ActiveWindow.ScrollRow = 1557
    ActiveWindow.ScrollRow = 1745
    ActiveWindow.ScrollRow = 2094
    ActiveWindow.ScrollRow = 2791
    ActiveWindow.ScrollRow = 3301
    ActiveWindow.ScrollRow = 3355
    ActiveWindow.ScrollRow = 3650
    ActiveWindow.ScrollRow = 3677
    ActiveWindow.ScrollRow = 3757
    ActiveWindow.ScrollRow = 3864
    ActiveWindow.ScrollRow = 3972
    ActiveWindow.ScrollRow = 4025
    ActiveWindow.ScrollRow = 4079
    ActiveWindow.ScrollRow = 4106
    ActiveWindow.ScrollRow = 4133
    ActiveWindow.ScrollRow = 4160
    ActiveWindow.ScrollRow = 4186
    ActiveWindow.ScrollRow = 4213
    ActiveWindow.ScrollRow = 4321
    ActiveWindow.ScrollRow = 4508
    ActiveWindow.ScrollRow = 4857
    ActiveWindow.ScrollRow = 5125
    ActiveWindow.ScrollRow = 5689
    ActiveWindow.ScrollRow = 6574
    ActiveWindow.ScrollRow = 6869
    ActiveWindow.ScrollRow = 7379
    ActiveWindow.ScrollRow = 7647
    ActiveWindow.ScrollRow = 7942
    ActiveWindow.ScrollRow = 8452
    ActiveWindow.ScrollRow = 8747
    ActiveWindow.ScrollRow = 9364
    ActiveWindow.ScrollRow = 10625
    ActiveWindow.ScrollRow = 11377
    ActiveWindow.ScrollRow = 11779
    ActiveWindow.ScrollRow = 12450
    ActiveWindow.ScrollRow = 12584
    ActiveWindow.ScrollRow = 12664
    ActiveWindow.ScrollRow = 12825
    ActiveWindow.ScrollRow = 12879
    ActiveWindow.ScrollRow = 12960
    ActiveWindow.ScrollRow = 13147
    ActiveWindow.ScrollRow = 13255
    ActiveWindow.ScrollRow = 13281
    ActiveWindow.ScrollRow = 13362
    ActiveWindow.ScrollRow = 13416
    ActiveWindow.ScrollRow = 13442
    ActiveWindow.ScrollRow = 13469
    ActiveWindow.ScrollRow = 13496
    ActiveWindow.ScrollRow = 13899
    ActiveWindow.ScrollRow = 13979
    ActiveWindow.ScrollRow = 14060
    ActiveWindow.ScrollRow = 14221
    ActiveWindow.ScrollRow = 14301
    ActiveWindow.ScrollRow = 14274
    ActiveWindow.ScrollRow = 14140
    ActiveWindow.ScrollRow = 14060
    ActiveWindow.ScrollRow = 13872
    ActiveWindow.ScrollRow = 13791
    ActiveWindow.ScrollRow = 13738
    ActiveWindow.ScrollRow = 13603
    ActiveWindow.ScrollRow = 13550
    ActiveWindow.ScrollRow = 13523
    ActiveWindow.ScrollRow = 13496
    ActiveWindow.ScrollRow = 13469
    ActiveWindow.ScrollRow = 13442
    ActiveWindow.ScrollRow = 13416
    ActiveWindow.ScrollRow = 13389
    ActiveWindow.ScrollRow = 13362
    ActiveWindow.ScrollRow = 13335
    



End Sub
 

Pièces jointes

  • exmacro.xls
    33.5 KB · Affichages: 56
Trier par date Trier par votes

Discussions similaires

F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
595
fanfan38
fanfan38
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
551
Kevin38
K
A
  • Résolu(e)
XL 2016 Regroupement dates sur TCD
Réponses
3
Affichages
308
Aldonanou
A
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
D
  • Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
2 K
chris
chris
D
  • Résolu(e)
XL 2019 TCD ajout automatique des nouveaux champs (VBA)
Réponses
1
Affichages
678
DelphineDF
D

Membres actuellement en ligne

22 membres et 442 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 156
Messages
2 085 813
Membres
102 989
dernier inscrit
Denver76