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

XL 2013 Macro VBA récupéré les données d'un tableau

Dafaka7

XLDnaute Junior
Bonjour à tous,
Je rencontre une difficulté à récupéré des données d'un tableau pour qu'il incrémente directement un autre tableau.
J'aimerais que lorsque la colonne K=201 sur la feuille BDD, la macro inscrit la quantité écrit dans la colonne D selon la référence et le N° de semaine
Merci d'avance pour votre aide.
cdlt
 

Pièces jointes

  • Copie de Suivi-consommation-0784 v2.xlsm
    734.2 KB · Affichages: 10
Solution
Bonjour Dafaka, bonjour le forum,

Essaie comme ça :

VB:
Sub Action()
Dim OB As Worksheet 'déclare la variable OB (Onglet Base)
Dim OC As Worksheet 'déclare la variable OC (Onglet Conso)
Dim TB As ListObject 'déclare la variable TB (Tableau structuré Base)
Dim TC As ListObject 'déclare la variable TC (Tableau structuré Conso)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim R As Range 'déclare la variable R (Recherche)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OB =...

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Dafaka, bonjour le forum,

Essaie comme ça :

VB:
Sub Action()
Dim OB As Worksheet 'déclare la variable OB (Onglet Base)
Dim OC As Worksheet 'déclare la variable OC (Onglet Conso)
Dim TB As ListObject 'déclare la variable TB (Tableau structuré Base)
Dim TC As ListObject 'déclare la variable TC (Tableau structuré Conso)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim R As Range 'déclare la variable R (Recherche)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OB = Worksheets("BDD ") 'définit l'onglet OB (Attention il y a un espace à la fin !)
Set OC = Worksheets("Conso 2020 Vs 2021") 'définit l'onglet OC
Set TB = OB.ListObjects(1) 'définit le tableau structuré TB
Set TC = OC.ListObjects(1) 'définit le tableau structuré TC
TV = TC.HeaderRowRange 'définit le tableau des valeurs TV (les en-êtes de TC)
For I = 1 To TB.ListRows.Count 'boucle 1 : sur toutes les lignes I du tableau structuré TB
    COL = 0: LI = 0 'reínitialise les variables COL et LI
    If TB.DataBodyRange(I, 11).Value = 201 Then 'condition : si la donnée ligne I colonne 11 de TB est égale à 201
        For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
            'si la donnée ligne 1 colonne J de TV est égale à la donnée ligne I colonne 1 de TB, définit la colonne COL, sort de la boucle
            If TV(1, J) = TB.DataBodyRange(I, 1).Value Then COL = J: Exit For
        Next J 'prochaine colonne de la boucle 2
        'définit la rechecher R (recherche la valeur de la donnée ligne I colonne 2 (la référence) dans la colonne 2 de TC)
        Set R = TC.DataBodyRange.Columns(2).Find(TB.DataBodyRange(I, 2), , xlValues, xlWhole)
        's'il existe au moins une occurrence trouvée, définit la ligne LI de la première occurrence trouvée
        If Not R Is Nothing Then LI = R.Row - TC.HeaderRowRange.Row
    End If 'fin de la condition
    'si ni COL ni LI sont égales à zéro, renvoie dans les données de TC ligne LI, colonne COL la valeur de la donnée ligne I colonne 4 de TB
    If COL <> 0 And LI <> 0 Then TC.DataBodyRange(LI, COL).Value = TB.DataBodyRange(I, 4)
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub

[Édition]
J'ai oublié de préciser... C'est couillon de mettre dans un onglet S01-2020 et dans un autre S1-2020. J'ai dû corriger dans le premier onglet en enlevant tous les 0 après de S pour que le code fonctionne...
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…