Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Copier la valeur de cellules non contigües de plusieurs feuilles vers une feuille récapitulative.

Droopyougo

XLDnaute Nouveau
Bonsoir le forum,
Je ne suis pas une flèche en Excel et sollicite votre aide pour résoudre un petit problème qui me tient en haleine depuis un moment...
Voici:
Dans un classeur Excel, j'ai:
- une première feuille "Facturé" qui reprend, sur plusieurs colonnes, les montants que j'ai facturé à mes clients. Certains champs sont des entrées clavier, d'autres le résultat de calculs simples (multiplication, addition). Il y a également un champs de dates et un autre de texte (référence facture).
- une seconde feuille "Payé" reprenant l'ensemble des dépenses effectuées. Là encore, certains champs sont introduits manuellement, d'autres sont calculés (+date et texte).
- une troisième feuille dans laquelle je voudrais recopier toutes les informations concernant par exemple la TVA.
Je sohaiterais que, au fur et à mesure que je remplis une ligne dans l'une des 2 premières feuilles, les informations voulues (cellules spécifiques non contigües) soient copiées automatiquement dans la première ligne disponible de la 3ème feuille. Il faut bien entendu que ce soit la valeur de la cellule qui soit copiée et non le calcul contenu dans cette cellule...
Pour l'instant, je fais cela manuellement, ce qui me prend beaucoup de temps et est susceptible d'introduire des erreurs.
Par exemple, je ne sais pas copier-coller les cellules calculées et je dois donc recopier manuellement le résultat dans la cellule cible.
Dans le monde des bisounours, je demanderais aussi à ce que les lignes soient insérées dans l'ordre en tenant compte de la date, mais s'il n'y a plus que ça, je devrait pouvoir faire le tri manuellement quand le besoin s'en fera sentir! ;-)

Je suis persuadé qu'Excel devrait permettre d'automatiser cela, mais malgré de longues recherches sur internet, je n'ai pas encore trouvé comment.
A toutes fins utiles, je joint un exemple de mon fichier...
Toute aide sera très appréciée.

Merci d'avance.
Cordialement
 

Pièces jointes

  • Bilan 2023.xlsx
    32 KB · Affichages: 7

vgendron

XLDnaute Barbatruc
Bonjour

une question ou deux
1) les cases à cocher sont elles indispensables? à priori, elles ne servent à rien..?
2) les accomptes de TVA sont apparemment saisis directement dans la feuille TVA==> est il possible de créer une feuille spécifique juste pour les accomptes?
ce qui au final, permettrait de rappatrier toutes les infos dans une seule

ton fichier ressemblerait à ca:
 

Pièces jointes

  • Bilan 2023.xlsx
    45.2 KB · Affichages: 1

vgendron

XLDnaute Barbatruc
dans la solution ci jointe, par Power Query

les données sont mises en tableau structuré
à chaque fois que tu saisis une nouvelle ligne, le tableau s'agrandi automatiquement pour intégrer la nouvelle ligne

ensuite: dans la feuille TVA (celle de récap), tu fais un clic droit sur le tableau / actualiser
et voila
 

Pièces jointes

  • Bilan 2023.xlsx
    48.6 KB · Affichages: 5

Droopyougo

XLDnaute Nouveau
Bonjour,
Merci déjà pour ta réponse.
1) Non, les cases à cocher ne sont pas indispensables. Elles ne me servent que pour la mise en forme conditionnelle.
2) Les acomptes sont effectivement saisis directement dans la feuille TVA. Cela ne me pose paas de problème d'avoir une feuille distincte pour leur saisie.

Je regarde à ton fichier et reviens vers toi pour te dire ce que j'en pense.
 

Droopyougo

XLDnaute Nouveau
Bonjour,
A première vue, ta solution répond bien à ce que je souhaite... Merci!
Par contre, pourrais-tu m'expliquer ce que tu as fait, comment, pourquoi, histoire que je comprenne/apprenne pour d'autres occasions...
Merci.
 

vgendron

XLDnaute Barbatruc
hello

c'est une solution Power Query (outil que je découvre seulement)
1) dans chaque feuille de saisie, les données sont transformées en tableau structurés dont les noms sont: "Tab_Facturé" - "Tab_Payé" "Tab_Accompte"

2) ces 3 tab sont importés par power query,
une mise en forme est effectuée sur chacun d'entre eux (suppression de colonnes inutiles, ajouts de colonnes, format des données) pour que les 3 aient la meme structure finale (celle du tableau résultat dans la feuille TVA)
3) les 3 tab "similaires" sont combinés pour n'en faire qu'un
4) et le résultat est mis dans la feuille TVA

==> chaque fois que tu modifies un des 3 tableaux "Tab_xxx", une actualisation du tableau final effectue le traitement.

à noter: le traitement ne modifie pas tes tableaux initiaux
 

Droopyougo

XLDnaute Nouveau
Je ne connaissais pas cet outil.
Ca m'a l'air d'être vachement rapide et bien fait, mais il va sans doute encore me falloir un peu de temps avant de le maîtriser!
Merci de me l'avoir fait découvrir.
Ce me sera certainement bien utile pour d'autres fichiers.
J'ai déjà pu lire et voir qu'il y a un autre outil qui s'y rapporte et qui s'appellerait Power Pivot qui créerait "automatiquement" les tables pivot ainsi que les graphiques...
Décidément, on n'utilise vraiment, en général, que quelques pourcents des capacités de ce programme!
Et quand je regarde autour de moi, je trouve que je suis déjà un utilisateur "avancé" !
Bref, cela fonctionne, je vais maintenant pouvoir "m'amuser" à peaufiner les détails!

Encore un tout grand merci pour ton aide.
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @Droopyougo , bonsoir @vgendron

Comme d'habitude j'arrive après la bataille (je suis plus long à la détente que bien d'autres), avec une solution VBA pour Excel365 et 2021, (utilisation des fonctions dynamiques Filtre() et Trier() dans le VBA).

Donc pour la curiosité ...
Résumé :
  • J'ai également transformé tes tableaux de données en tableaux structurés (tb_Facturé, tb_Payé, tb_Suivi_TVA)
  • J'ai laissé les acomptes dans le tableau tb_Suivi_TVA
  • J'ai conservé l'idée des cases à cocher mais avec une formule et une police de caractères et non pas des objets.
  • Il y a 4 mises en forme conditionnelles dans la feuille "Facturé"
  • 1er gadget : le sens de déplacement après la touche Entrée vers la droite (plus pratique pour saisir en ligne). Il est rétablit à sa valeur initiale lorsque l'on va sur une feuille non concernée.
  • 2ème gadget : quand on clique dans une cellule située juste sous un tableau celui-ci s'étend avant même de saisir une donnée. Pratique pour conserver l'espace entre le tableau et les synthèses situées plus bas.
  • 3ème gadget les pseudo-cases à cocher (citées plus haut) pour remplir ou effacer les dates associées :
    -quand on clique sur une case non cochée, la date se remplit avec la date du jour,
    -quand on clique sur une case cochée, je propose d’effacer la date.
  • Appel de la macro de mise à jour lorsque l'on active la feuille "Suivi TVA"
  • L'ordre de tri et décroissant (dates les plus récentes en haut de tableau)
LE CODE : (j'ai commenté pour en facilité l'appropriation)

Le module mdl_AtTheOne
Enrichi (BBcode):
Sub MàJ_Suivi_TVA()
     Dim ResF, ResP, ResV, Tmp, MaDim As Long, nbDim As Integer, NbLgn As Long, Sz As Long, i As Long, j As Long
     Dim LO As ListObject
  
     MaDim = 0
     'COLLECTE DES DONNEES
     'TVA perçue
     Tb = Sh_Facturé.[tb_Facturé].Value2                                  'données dans le tableau tb
     Sz = UBound(Tb, 1)
     ReDim Test(1 To Sz, 1 To 1)
     For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 10)): Next           'tableau logique pour la fonction filter (date réception non vide)
     Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
     'type de résultat du filtre
     If IsArray(Tmp) Then
          MaDim = UBound(Tmp, 1)
          nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2): On Error GoTo 0
          '1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
          If nbDim = -1 Then
               ReDim ResF(1 To 1, 1 To MaDim)
               For i = 1 To MaDim: ResF(1, i) = Tmp(i): Next
               NbLgn = NbLgn + 1    'Total des lignes filtrées
          Else
          '2) à deux dimensions (Plusieurs lignes filtrées)
               ResF = Tmp
               NbLgn = NbLgn + MaDim    'Total des lignes filtrées
          End If
     Else
          '3) Aucun résultats (résultat= "NA")
          ResF = Tmp
     End If
  
     'TVA payée
     Tb = Sh_Payé.[tb_Payé].Value2                                        'données dans le tableau tb
     Sz = UBound(Tb, 1)
     ReDim Test(1 To Sz, 1 To 1)
     For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 1)): Next            'tableau logique pour la fonction filter (date de paiement non vide)
     Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
     'type de résultat du filtre
     If IsArray(Tmp) Then
          MaDim = UBound(Tmp, 1)
          nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2)
          '1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
          If nbDim = -1 Then
               ReDim ResP(1 To 1, 1 To MaDim)
               For i = 1 To MaDim: ResP(1, i) = Tmp(i): Next
               NbLgn = NbLgn + 1    'Total des lignes filtrées
          Else
          '2) à deux dimensions (Plusieurs lignes filtrées)
               ResP = Tmp
               NbLgn = NbLgn + MaDim    'Total des lignes filtrées
          End If
     Else
          '3) Aucun résultats (résultat= "NA")
          ResP = Tmp
     End If
  
     'TVA versée
     Tb = Sh_Suivi.[tb_Suivi_TVA].Value2                                  'données dans le tableau tb
     Sz = UBound(Tb, 1)
     ReDim Test(1 To Sz, 1 To 1)
     For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 3)): Next            'tableau logique pour la fonction filter (acompte non vide)
     Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
     'type de résultat du filtre
     If IsArray(Tmp) Then
          MaDim = UBound(Tmp, 1)
          nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2)
          '1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
          If nbDim = -1 Then
               ReDim ResV(1 To 1, 1 To MaDim)
               For i = 1 To MaDim: ResV(1, i) = Tmp(i): Next
               NbLgn = NbLgn + 1
          Else
          '2) à deux dimensions (Plusieurs lignes filtrées)
               ResV = Tmp
               NbLgn = NbLgn + MaDim
          End If
     Else
          '3) Aucun résultats (résultat= "NA")
          ResV = Tmp
     End If
  
     'MISE A JOUR DU TABLEAU RECAPITULATIF
     'redimensionner le tableau structuré
     Set LO = Sh_Suivi.ListObjects("tb_Suivi_TVA")
     Sh_Suivi.[tb_Suivi_TVA].ClearContents
     Select Case NbLgn
          Case 0
               LO.Resize LO.HeaderRowRange.Resize(2)
               Exit Sub
          Case 1
               LO.Resize LO.HeaderRowRange.Resize(2)
          Case Is > 1
               LO.Resize LO.HeaderRowRange.Resize(NbLgn + 1)
     End Select
  
     'Concaténation des lignes filtrées
     ReDim Résult(1 To NbLgn, 1 To 5)
     If IsArray(ResF) Then
          j = 0
          For i = 1 To UBound(ResF)
               j = j + 1
               Résult(j, 1) = ResF(i, 10)         'La date de réception (en colonne 10)
               Résult(j, 2) = ResF(i, 5)          'Le montant de la TVA perçue (en colonne 5)
               Résult(j, 5) = ResF(i, 11)         'La référence (en colonne 11)
          Next
     End If
     If IsArray(ResP) Then
          For i = 1 To UBound(ResP)
               j = j + 1
               Résult(j, 1) = ResP(i, 1)          'La date de paiement (en colonne 1)
               Résult(j, 4) = ResP(i, 4)          'Le montant de la TVA payée (en colonne 4)
               Résult(j, 5) = ResP(i, 6)          'La référence (en colonne 6)
          Next
     End If
     If IsArray(ResV) Then
          For i = 1 To UBound(ResV)
               j = j + 1
               Résult(j, 1) = ResV(i, 1)          'La date de versement (en colonne 1)
               Résult(j, 3) = ResV(i, 3)          'Le montant de l'accompte (en colonne 3)
               Résult(j, 5) = ResV(i, 5)          'La référence (en colonne 5)
          Next
     End If
  
     'Remplissage du tableau structuré après tri sur la colonne 1 (des dates)
     Sh_Suivi.[tb_Suivi_TVA] = WorksheetFunction.Sort(Résult, 1, -1)

End Sub

Code de la feuille "Facturé"
Enrichi (BBcode):
Private Sub Worksheet_Activate()
     'Déplacement vers la droite (pour rester sur la même ligne)
     Application.MoveAfterReturnDirection = xlToRight
End Sub

Private Sub Worksheet_Deactivate()
     'Rétablissement du mode de déplacement initial
     Application.MoveAfterReturnDirection = MoveDirection
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim DataLo As Range
  
     'Ajout d'une ligne au tableau structuré lors de la sélection d'une cellule immédiatement sous celui-ci
     Set DataLo = Me.[tb_Facturé]
     If Target.Count = 1 And Target.Row = DataLo.Rows(DataLo.Rows.Count).Row + 1 And Target.Column >= DataLo.Column And Target.Column < DataLo.Column + DataLo.Columns.Count Then
          Target.Offset(1).EntireRow.Insert
          DataLo.ListObject.Resize DataLo.ListObject.Range.Resize(DataLo.ListObject.Range.Rows.Count + 1)
     End If
     'Modification automatique de la date de facturation sur sélection de la pseudo case à cocher
     If Target.Count = 1 And Not Intersect(Target, Me.[tb_Facturé[Envoyé]]) Is Nothing Then
          Select Case Target.Value
               Case "¨"
                    Target.Offset(0, 1).Value = Date: Application.EnableEvents = False: Target.Offset(0, 1).Select: Application.EnableEvents = True
               Case "þ"
                    If MsgBox(prompt:="Effacer date d'envoi ?", Buttons:=vbYesNo) = vbYes Then Target.Offset(0, 1).ClearContents: Application.EnableEvents = False: Target.Offset(0, 1).Select: Application.EnableEvents = True
          End Select
     End If
     'Modification automatique de la date d'encaissement sur sélection de la pseudo case à cocher
     If Target.Count = 1 And Not Intersect(Target, Me.[tb_Facturé[Reçu]]) Is Nothing Then
          Select Case Target.Value
               Case "¨"
                    Target.Offset(0, 1).Value = Date: Application.EnableEvents = False: Target.Offset(0, 1).Select: Application.EnableEvents = True
               Case "þ"
                    If MsgBox(prompt:="Effacer date de réception ?", Buttons:=vbYesNo) = vbYes Then Target.Offset(0, 1).ClearContents: Application.EnableEvents = False: Target.Offset(0, 1).Select: Application.EnableEvents = True
          End Select
     End If
End Sub

Code de la feuille "Payé"
Enrichi (BBcode):
Private Sub Worksheet_Activate()
     'Déplacement vers la droite (pour rester sur la même ligne)
     Application.MoveAfterReturnDirection = xlToRight
End Sub

Private Sub Worksheet_Deactivate()
     'Rétablissement du mode de déplacement initial
     Application.MoveAfterReturnDirection = MoveDirection
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim DataLo As Range
     'Ajout d'une ligne au tableau structuré lors de la sélection d'une cellule immédiatement sous celui-ci
     Set DataLo = Me.[tb_Payé]
     If Target.Count = 1 And Target.Row = DataLo.Rows(DataLo.Rows.Count).Row + 1 And Target.Column >= DataLo.Column And Target.Column < DataLo.Column + DataLo.Columns.Count Then
          Target.Offset(1).EntireRow.Insert
          DataLo.ListObject.Resize DataLo.ListObject.Range.Resize(DataLo.ListObject.Range.Rows.Count + 1)
     End If

End Sub

Code de la feuille "Suivi TVA"
Enrichi (BBcode):
Private Sub Worksheet_Activate()
     'Déplacement vers la droite (pour rester sur la même ligne)
     Application.MoveAfterReturnDirection = xlToRight
  
     'Mise à jour de l'état TVA
     Application.ScreenUpdating = False
     MàJ_Suivi_TVA
     Application.ScreenUpdating = True
  
End Sub

Private Sub Worksheet_Deactivate()
     'Rétablissement du mode de déplacement initial
     Application.MoveAfterReturnDirection = MoveDirection
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim DataLo As Range
  
     'Ajout d'une ligne au tableau structuré lors de la sélection d'une cellule immédiatement sous celui-ci
     Set DataLo = Me.[tb_Suivi_TVA]
     If Target.Count = 1 And Target.Row = DataLo.Rows(DataLo.Rows.Count).Row + 1 And Target.Column >= DataLo.Column And Target.Column < DataLo.Column + DataLo.Columns.Count Then
          Target.Offset(1).EntireRow.Insert
          DataLo.ListObject.Resize DataLo.ListObject.Range.Resize(DataLo.ListObject.Range.Rows.Count + 1)
     End If

End Sub

Code du classeur (ThisWorkbook)
Enrichi (BBcode):
Public MoveDirection As Long

Private Sub Workbook_Open()
     'Mémorisation du sens de déplacement
     MoveDirection = Application.MoveAfterReturnDirection
      Application.MoveAfterReturnDirection = xlToRight
End Sub

Private Sub Workbook_Deactivate()
     'Restitution du sens de déplacement
     Application.MoveAfterReturnDirection = MoveDirection
End Sub

Pour l'efficacité, il faudrait comparer les deux solutions avec plus de données.
Voilà, voir la pièce jointe
Bon courage
Amicalement
Alain
 

Pièces jointes

  • Bilan 2023 AtTheOne.xlsm
    43.7 KB · Affichages: 3
Dernière édition:

Droopyougo

XLDnaute Nouveau
Bonjour Alain,
Un grand merci de t'être penché sur mon problème.
Je vais essayer d'appliquer ta solution à un classeur d'une précédente année comportant plus de données.
Par contre, cela me fait constater que je suis encore bien loin d'être capable de développer cela par moi-même...
En lisant ton code, il y a un grand nombre de lignes que je ne comprend pas!
Bien que j'ai été programmeur C, C++, C#, Delphi, ... dans une autre vie, il me manque manifestement la connaissance des syntaxes à utiliser pour coder en VBA!
J'en comprend certaines car assez proches de ce dont je me souviens encore , mais d'autres sont dans un langage totalement mystérieux!
Mais je suppose que c'est normal pour quelqu'un qui n'en a jamais fait et qui n'a plus mis les mains dans le cambouis depuis... très très longtemps.
Bref...
Merci encore et je te tiens au courant dès que j'aurai eu le temps d'appliquer ta solution sur un autre classeur.

Cordialement
 

Droopyougo

XLDnaute Nouveau
Bonjour toutes et tous,
Je viens de faire quelques tests sur le fichier solution d'Alain (AtTheOne) qui me semble fonctionner parfaitement.
C'est manifestement plus complexe que la solution proposée par vgendron, mais les deux fonctionnent comme souhaité.
L'avantage de la version VBA est une mise à jour automatique de la feuille récapitulative, là où la solution par Power Query demande un clic sur le tableau et la sélection de "Actualiser", ce qui permet éventuellement de supprimer/modifier des données en cas d'erreur sans répercussion immédiate sur le tableau récapitulatif. Mais comme la version VBA permet le retour en arrière avec mise à jour automatique... c'est un peu pareil au final.

Merci encore à tous deux pour l'aide rapide apportée.

Maintenant, je voudrais pouvoir utiliser l'une ou l'autre de ces solutions sur d'autres fichiers... soit identiques pour les années précédentes ou celles à venir, soit sur des fichiers différents après adaptation du code...
En ce qui concerne Power Query, après visionnage de quelques tutos, je pense que je devrais pouvoir y arriver, même si tout ne me paraît pas encore très clair et qu'une explication plus détaillée sur la création des tableaux, par exemple, ne serait pas de refus.
Mais, par contre, je ne serais pas contre une petite explication (claire, pour les (très) nuls) sur la manière d'inclure le code VBA dans un autre fichier.

Merci à quiconque aura la patience de m'expliquer cela...

Bonne journée

Cordialement
 

vgendron

XLDnaute Barbatruc
Hello
pour la création de tableau structuré
deux possibilités
1ere Solution: tout excel
1) tu selectionnes le tableau (ou clic sur une cellule du tableau suffit)
2) Acceuil / Mettre sous forme de tableau
3) tu choisis un sytle qui te plait
4) une boite demande l'emplacement des données==> normalement il a reconnu automatiquement la zone
5) tu coches ou pas "mon tableau comporte des en-têtes"
6)OK
==> les données ont été mises en tableau structuré

clic dans ce tableau:
onglet création / Propriétés==> tu peux mettre un nom au tableau pour remplacer le nom mis par défaut "tableauxx"

2eme solution: par power query
1) tu cliques dans la zone de données
2) power query / obternir des données externes à partir d'un tableau/d'une plage (ca c'est pour ma version 2010,.. en 365, je crois que c'est dans le menu "Data importer....)
3) meme fenetre ou presque pour l'emplacement des données
4) OK.. et voila.. à part que l'éditeur PowerQuery s'ouvre: c'est la que tu peux changer le nom du tableau (je viens de le découvrir à l'instant)

pour power query.. je ne peux pas vraiment t'en dire plus. je le découvre depuis quelques jours seulement
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @Droopyougo

En PJ une nouvelle version avec de nombreux commentaires, où j'ai supprimer le gadget de changement de sens de déplacement après la touche Entrée et où j'ai regroupé les séquences qui pouvaient l'être en créant deux Sub paramétrées.

POUR UTILISER DANS UN AUTRE CLASSEUR
Ce classeur doit comprendre les trois feuilles avec les tableaux structurés ayant les mêmes colonnes que dans la pièce jointe (du moins avec les données à utiliser placées dans les mêmes colonnes que celles de la pièce jointe.
Le Code que j'emploie utilise le nom VBA que j'ai donné au 3 feuilles :
Facturé -> Sh_Facturé
Payé -> Sh_Payé
Suivi_VA -> Sh_Suivi

Un petit GIF de la procédure à suivre
Tu utilises ces noms ou tu les modifies dans le code.

Comme @vgendron j'ai créé des tableaux structurés pour accueillir les données :

Donc tu suis la procédure indiquée au post #11 pour les créer et tu respectes les noms donnés ci-dessus (Ou tu remplaces dans le code le noms des tableaux par ceux que tu as donnés).

Pour récupérer le code dans ton autre classeur, ouvre les deux classeurs,
recopie le code des feuilles par CTRL C ; CTRL V
à l'aide d'un Glisser-Déplacer glisse le module "mdl_AtTheOne" vers le classeur cible, ou crée un module et fait un copier coller du contenu de "mdl_AtTheOne" dans ce nouveau module de ton classeur cible.
Voici un gif animé de toute la procédure :


Le nouveau code du module mdl_AtTheOne
Enrichi (BBcode):
Sub MàJ_Suivi_TVA()
    'Déclaration des variables utilisées
     Dim ResF, ResP, ResV,  NbLgn  As Long,  j As Long
     Dim LO As ListObject
     'En l'absence de typage le type est "Variant" (qui peut tout contenir)
     'ListObject est l'objet VBA pour un tableau structuré (il embarque les propriétés et méthodes liées à cet objet)
    
     NbLgn = 0
          'initilisation à 0 du nombre de lignes collectées
'COLLECTE DES DONNEES
     'TVA perçue
     Call Extraction(Sh_Facturé.[tb_Facturé].Value2, 10, ResF, NbLgn)
          'la syntaxe 'Sh_Facturé.[tb_Facturé] renvoie la plage occupée par les données du tableau
          '[tb_Facturé] est évalué comme le nom "tb_facturé" qui renvoie à la plage de données du tableau structuré "tb_Facturé"
          '.Value2 renvoie les valeurs des cellules de la plage (en s'affranchissant du type date)
    'TVA payée
     Call Extraction(Sh_Payé.[tb_Payé].Value2, 1, ResP, NbLgn)
     'TVA versée
     Call Extraction(Sh_Suivi.[tb_Suivi_TVA].Value2, 3, ResV, NbLgn)
   
'MISE A JOUR DU TABLEAU RECAPITULATIF
    'redimensionner le tableau structuré "tb_Suivi_TVA" pour recevoir les résultats trouvés
     Set LO = Sh_Suivi.ListObjects("tb_Suivi_TVA")
     'LO est défini comme le ListObject " tb_Suivi_TVA " de la feuille " Sh_Suvi "
     Sh_Suivi.[tb_Suivi_TVA].ClearContents
          'On vide les données de la plage "tb_Suivi_TVA"
     Select Case NbLgn
          'Actions en fonction du nombre de lignes trouvées
          Case 0
               'Aucune ligne trouvée
               LO.Resize LO.HeaderRowRange.Resize(2)
                    'On redimensionne le tableau à deux lignes (Entêtes et une ligne vide)
               Exit Sub
                    'On sort de la procédure
          Case 1
               LO.Resize LO.HeaderRowRange.Resize(2)
                    'On redimensionne le tableau à deux lignes (Entêtes et une de données)
          Case Is > 1
               LO.Resize LO.HeaderRowRange.Resize(NbLgn + 1)
                    'On redimensionne le tableau à (NbLgn + 1) lignes (Entêtes et NbLgn lignes de données)
     End Select
   
     'Concaténation des résultats dans le tableau Résult
     ReDim Résult(1 To NbLgn, 1 To 5)
          'Dimensionnement d'un tableau résultat de NbLgn lignes et 5 colonnes)
          'On va pour chaque résultat filtré plus haut ramener les valeurs ad hoc dans le tableau Résult
     j = 0
          'Initialisation du N° de ligne dans Résult à 0
     'TVA perçue
     Call Restituer(Résult, j, ResF, 2, 10, 5, 11)
          'On place dans Résult, après la ligne j, en col 2 le montant de la TVA facturé qu'on trouve en col 5, la date qu'on trouve en col 10, la référence qu'on trouve en col 11)
     'TVA payée
     Call Restituer(Résult, j, ResP, 4, 1, 4, 6)
          'On place dans Résult après la ligne j, en col 3 le montant de la TVA payé qu'on trouve en col 4, la date qu'on trouve en col 1, la référence qu'on trouve en col 6)
     'TVA versée     
     Call Restituer(Résult, j, ResV, 3, 1, 3, 5)
    'On place dans Résult après la ligne j, en col 3 le montant de la TVA versé qu'on trouve en col 3, la date qu'on trouve en col 1, la référence qu'on trouve en col 5)
     'Remplissage du tableau structuré après tri sur la colonne 1 (des dates)
     Sh_Suivi.[tb_Suivi_TVA] = WorksheetFunction.Sort(Résult, 1, -1)
          'Affectation directe à la plage " tb_Suivi_TVA" de la feuille Sh_Suivi des valeurs contenues dans le tableau Résult
          'WorksheetFonction.Sort est la fonction Excel TRIER (argument1 le tableau à trier, argument2 le n° de la clef de tri, Argument3 -1 ordre décroissant)
End Sub

Enrichi (BBcode):
Sub Extraction(ByVal Tb As Variant, ByVal ColTest As Integer, ByRef Res, ByRef NbLgn As Long)
'Extraire du tableau Tb les lignes dont la colonne ColTest n'est pas vide
'Les charger dans le tableau passé en référence Res, et mettre à jour dans NbLgn (passé en référence) le nbre de lignes trouvées
     Dim Sz As Long, Test, Tmp, nbCol As Long, nbDim As Integer, i As Long
     Sz = UBound(Tb, 1)
          'Sz va contenir le nombre de lignes de tb
     ReDim Test(1 To Sz, 1 To 1)
          'On dimensionne dynamiquement le tableau Test à 2 dimensions (Sz Lignes, 1 colonne)
     For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, ColTest)): Next
          'tableau logique "Test" à 2 dimensions (pour chaque ligne i la colonne 1 contient TRUE ou FALSE selon date réception non vide ou vide)
     Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
          'WorksheetFunction.Filter est la fonction Excel FITRER()( argument1 le tableau à filtrer, argument2 le critère de filtre, argument3 résultat si aucune correspondance)
          'Résultat du filtre dans le tableau Tmp , -filtrer le tableau tb en fonction, pour chaque ligne, de la valeur de Test, " NA " si aucune lignes ne convient.
     If IsArray(Tmp) Then
          'Si le résultat est un tableau (<> de la chaîne "NA"), donc au moins une ligne trouvée respectant le critère.
          'Il y à 2 cas : si une seule ligne trouvée le tableau est à une dimension (de MaDim colonnes), sinon il est à 2 dimensions (MaDim lignes, nbCol colonnes)
          MaDim = UBound(Tmp, 1)
          nbCol = -1: On Error Resume Next: nbCol = UBound(Tmp, 2)
               'Si le tableau est à 1 dimension il y a une erreur, nbCol est inchangée et vaut -1, sinon nbCol contient le nbre de colonnes du tableau.
          If nbCol = -1 Then
               '1) à une dimension (1 seule ligne filtrée) : MaDim contient le Nbre de colonnes, on convertit en tableau à 2 dimensions (1 ligne, MaDim colonnes)
               ReDim Res(1 To 1, 1 To MaDim)
               For i = 1 To MaDim: Res(1, i) = Tmp(i): Next
                    'Transfert du résultat dans le tableau Res (colonne par colonne)
               NbLgn = NbLgn + 1
                    'Total des lignes filtrées
          Else
               '2) à deux dimensions (Plusieurs lignes filtrées)
               Res = Tmp
                    'Transfert du tableau dans un le Tableau Res (affectation directe)
               NbLgn = NbLgn + MaDim
                    'Total des lignes filtrées
          End If
     Else
          '3) Aucun résultats (Tmp= "NA")
          Res = Tmp
               'Transfert dans Res
     End If
   
End Sub

Enrichi (BBcode):
Sub Restituer(ByRef Résult, ByRef j As Long, ByRef Res, ByVal ColVal As Long, ByVal Col1 As Integer, ByVal Col2 As Integer, ByVal Col3 As Integer)
'Restituer dans le tableau Résult (passé en référence) après la ligne j (passée en référence) les données récupérées dans le tableau Res (passé en référence)
'ColVal: N° de col où placer la TVA dans Résult, Col1: N° de col contenant la date dans Res, Col2: N° de la col contenant la TVA dans Res, Col3: N° de col contenant la référence dans Res
     Dim i As Long
   If IsArray(Res) Then
          'Si Rés est un tableau (il y a des résultats filtrés)
          For i = 1 To UBound(Res)
               j = j + 1
                    'on incrémente le N° de la ligne à remplir
               Résult(j, 1) = Res(i, Col1)
                    'On place en colonne 1 la date trouvée en colonne Col1
               Résult(j, ColVal) = Res(i, Col2)
                    'On place en colonne ColVal la TVA trouvée en colonne Col2
               Résult(j, 5) = Res(i, Col3)
                    'On place en colonne 5 la référence trouvée en colonne Col3
          Next
     End If
End Sub
Ne pas s'affoler avec la longueur du code : sans les commentaires c'est beaucoup plus court !

Pour approfondir il y a aussi la documentation Microsoft (voir ce lien) en particulier la référence du langage et le modèle objet EXCEL.

Voilà j'espère que ça t'éclairera un peu
Amicalement
Alain
 

Pièces jointes

  • Bilan 2023 AtTheOne 2.xlsm
    45.9 KB · Affichages: 5
Dernière édition:

Droopyougo

XLDnaute Nouveau
Grand merci Alain.
Superbe tuto bien expliqué et visuel.
Je n'ai pas encore tout bien compris, mais il y a déjà plus de clarté!
Je vais essayer de bien comprendre le code, à tête reposée...
Ce dont je vais certainement avoir besoin, c'est d'une sorte de lexique pour comprendre ce que représente chaque terme utilisé dans le code et à quoi il se rapporte.
Je pense que je devrais pouvoir trouver ça soit via le lien que tu donnes, soit en cherchant un peu sur le net.
Je sens que je serai un peu moins bête en me couchant ce soir!
Bonne journée.
Cordialement
 

Discussions similaires

Réponses
12
Affichages
548
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…