Bonjour
Chez moi pour quelques comptes c'est instantané mais cela m'intéresse de savoir combien tu en as et de voir tes adaptations...
@suivre
Bonjour
Chez moi pour quelques comptes c'est instantané mais cela m'intéresse de savoir combien tu en as et de voir tes adaptations...
@suivre
Chris
PowerQuery existe depuis plus de 13 ans, est totalement intégré à Excel 2016 &+. Utilisez-le !
Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
Confucius
----------------------------------------------------------------------------------------------
En cas de résolution, n'hésitez pas cliquer sur c'est toujours apprécié...
Bonjour
voici mon final
Option Explicit
et voila le fichier
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
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 Sub Copy_Avec_AdvancedFilter() Dim oSheetData As Excel.Worksheet Dim ShGrLvr As Worksheet Dim ShActuelle As Worksheet Dim RgData As Range, RgCriter As Range Dim DerLig As Long, DerLigW As Long, i As Long, LastRow As Long, LastRowSolde As Long Dim Cpt As String Set ShGrLvr = ThisWorkbook.Worksheets("Grand livre") Set RgData = ShGrLvr.Range("TablGrLivre[#All]") Set RgCriter = ShGrLvr.Range("TablCritere[#All]") DerLig = ShGrLvr.Cells(ShGrLvr.Rows.Count, 1).End(xlUp).Row With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With If ShGrLvr.FilterMode = True Then ShGrLvr.ShowAllData End If ShGrLvr.Columns("W").ClearContents ShGrLvr.Range("E1:E" & DerLig).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ShGrLvr.Range("W1"), Unique:=True DerLigW = ShGrLvr.Cells(ShGrLvr.Rows.Count, 23).End(xlUp).Row For i = 2 To DerLigW ShGrLvr.Range("P2").Value = ShGrLvr.Range("W" & i).Value Cpt = ShGrLvr.Range("P2").Value If SheetExist(Cpt) Then Set ShActuelle = ThisWorkbook.Worksheets(Cpt) LastRow = ShActuelle.Cells(ShActuelle.Rows.Count, 1).End(xlUp).Row + 4 RgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RgCriter, CopyToRange:=ShActuelle.Cells(LastRow, 1) ShActuelle.Rows(LastRow - 3 & ":" & LastRow).Delete Shift:=xlUp Else Sheets("Masque").Copy After:=Sheets(Sheets.Count) Set oSheetData = Sheets(Sheets.Count) oSheetData.Name = Cpt Set ShActuelle = ThisWorkbook.Worksheets(Cpt) LastRow = ShActuelle.Cells(ShActuelle.Rows.Count, 1).End(xlUp).Row + 1 RgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RgCriter, CopyToRange:=ShActuelle.Cells(LastRow, 1) ShActuelle.Rows(LastRow & ":" & LastRow).Delete Shift:=xlUp End If Next i For Each oSheetData In ThisWorkbook.Worksheets With oSheetData If .Name <> "Grand livre" And .Name <> "Masque" Then LastRowSolde = oSheetData.Cells(oSheetData.Rows.Count, 1).End(xlUp).Row oSheetData.Range("G6").Value = oSheetData.Range("I" & LastRowSolde).Value oSheetData.Columns("I:J").ClearContents oSheetData.Range("F" & LastRowSolde + 1).Value = "TOTAUX" oSheetData.Range("G" & LastRowSolde + 1).FormulaLocal = "=SOUS.TOTAL(9;G9:G" & LastRowSolde & " )" oSheetData.Range("H" & LastRowSolde + 1).FormulaLocal = "=SOUS.TOTAL(9;H9:H" & LastRowSolde & " )" oSheetData.Range("F" & LastRowSolde + 2).Value = "SOLDE COMPTABLE RECTIFI" oSheetData.Range("G" & LastRowSolde + 2).FormulaLocal = "=G" & (LastRowSolde + 1) & "-H" & (LastRowSolde + 1) & "" oSheetData.Range("F" & LastRowSolde + 3).Value = "DIFF" oSheetData.Range("G" & LastRowSolde + 3).FormulaLocal = "=G6" & "-G" & (LastRowSolde + 2) & "" End If End With Next oSheetData With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With Application.CutCopyMode = False End Sub Function SheetExist(strSheetName As String) As Boolean Dim i As Integer For i = 1 To Worksheets.Count If Worksheets(i).Name = strSheetName Then SheetExist = True Exit Function End If Next i End Function
Svp S'il y a une modification pour améliorer ou augmenter la vitesse d’exécution du code aidez moi
merci
Bonjour
Je vois que tu as abandonné PowerQuery...
Effectivement le filtre avancé est ici plus rapide (moins d'une seconde sur mon PC)
Merci de retour
Chris
PowerQuery existe depuis plus de 13 ans, est totalement intégré à Excel 2016 &+. Utilisez-le !
Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.
Confucius
----------------------------------------------------------------------------------------------
En cas de résolution, n'hésitez pas cliquer sur c'est toujours apprécié...
Bonjour
Oui j'ai constaté que advencefiltre est très rapide vu le nombre de ligne à ventilé
Svp Mr Chris ou quelqu'un de forum s'il ya une modification dans le code ça me fait plaisir et merci à tous
Bonjour,
Evidemment que cette méthode est rapide, j'exporte 64000 lignes avec 50 colonnes dont certaines avec formules en deux secondes et même si certain peuvent trouver cette méthode dépassée, je l'utilise toujours en clientèle.Oui j'ai constaté que advencefiltre est très rapide vu le nombre de ligne à ventilé
De plus je pilote toutes mes applications avec un tableau extérieure où je place tous les paramètres nécessaires (Sort, Filter, etc.)
Cela a le gros avantage d'être mise en place rapidement
En ce qui concerne ta procédure, tu pratiques exactement comme je le fais, liste unique placée deux colonnes à droite de la liste des données, sauf que to, tu utilises une adresse absolue alors que moi je la calcule automatiquement, cela rend plus perenne l'application
Voir un billet Créer une liste unique de données contenues dans une colonne d'un tableau structuré à ce sujet
Philippe Tulliez
Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager