Problème avec Pour adapter une macro

T

Thepower

XLDnaute Nouveau
Bonjour,

je suis bloqué pour adapter une macro, pour laquelle on m'a déja aidé ici.

Voici le problème.
J'ai un Classeur avec un onglet Vision PDV, un deuxième avec Vision PDV 1, un troisième avec Macro, et le dernier avec Liste pdv.

La macro est sur l'onglet Macro : Lorsqu'on sélectionne un numéro de pdv dans la liste, automatiquement le tableau en dessous s'alimente a partir du premier onglet.

Ce que je n'arrive pas a faire c'est modifier la macro pour qu'elle fasse la même chose pour l'onglet Vison PDV 1, en sachant qu'a terme il y aura 5 nouveau onglet (correspondant au prériode, qui arriveront au fur et à mesure du temps). Donc la macro doit pouvoir gerer les nouveau onglet au fur et a mesure de leur arrivé pour remplir le tableau ( de l'onglet macro).

Si quelqu'un maitrise VBA et ce sent altruiste aujourd’hui. Ce qui me permet de continuer à progresser dans mon apprentissage du VBA.

Merci


Le fichier étant lourd voici le lien : http://cjoint.com/?DCyjDuUf9cT
 
Trier par date Trier par votes
gilbert_RGI

gilbert_RGI

XLDnaute Barbatruc
Re : Problème avec Pour adapter une macro

Bonjour

Comme ceci peut-être

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, k&, CodePdV$
Dim D As Object, T As Variant
sh = Array("Vision PDV", "Vision PDV 1") 'ici mettre vos autres pages
For k = 0 To 1 ' modifier ici le nombre de pages suivant le nombre dans le array
'Si le changement de valeurs est en B1
If Not Intersect(Target, Range("$B$1")) Is Nothing Then
    'on cré un dictionnaire
    Set D = CreateObject("scripting.dictionary")
    'On récupère le code choisi
    CodePdV = CStr(Target.Value)
    'Avec la feuille Vision PDV
    With Sheets("sh(k)")
        'On récupère toutes les valeurs dans un tableau
        'depuis A$ (Cell(2,1)
        'Jusqu'a la dernière cellule remplie en colonne T .Cells(.Rows.Count, 20).End(3))
        T = .Range(.Cells(2, 1), .Cells(.Rows.Count, 20).End(3))
    End With
        
    'Pour chaque ligne de notre tableau
    For i = LBound(T, 1) To UBound(T, 1)
        'Si la valeur en colonne 1 est égale au code choisi
        If CStr(T(i, 3)) = CodePdV Then
            'On incréménte j
            j = j + 1
            'L'entrée J du dictionnairte est égale aux valeurs ligne i colonne 11
            'et valeur ligne i colonne 20 de notre tableau
            D(j) = Array(T(i, 11), T(i, 20))
        'Fin de la condition
        End If
    'Prochaine ligne du tableau
    Next i
    'On vide la plage utilisée sur la feuille (UsedRange)
    Cells(3, 2).Resize(UsedRange.Rows.Count, 2).ClearContents
    ' si J > 0 (donc si il y a des entrées dans le dictionnaire
    If j Then
        'on colle les vbaleurs du dictionnaire
        Cells(3, 2).Resize(j, 2) = Application.Index(D.Items, , 0)
    'Sinon (si le dictionnaire est vide
    Else
        'On annonce la situation
        MsgBox "Pas de données pour ce code", 64, "Fin du traitement"
    'Fin de la condition des entrée du dictionnaire
    End If
'Fin de la condition du changement de cellule
End If
Next
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
gilbert_RGI

gilbert_RGI

XLDnaute Barbatruc
Re : Problème avec Pour adapter une macro

Bon alors ça ne bug plus chez moi

Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, k, CodePdV$, sh, j
Dim D As Object, T As Variant
sh = Array("Vision PDV", "Vision PDV 1") 'ici mettre vos autres pages
For k = 0 To 1 ' modifier ici le nombre de pages suivant le nombre dans le array
'Si le changement de valeurs est en B1
If Not Intersect(Target, Range("$B$1")) Is Nothing Then
    'on cré un dictionnaire
    Set D = CreateObject("scripting.dictionary")
    'On récupère le code choisi
    CodePdV = CStr(Target.Value)
    'Avec la feuille Vision PDV
    With Sheets("sh(k)")
        'On récupère toutes les valeurs dans un tableau
        'depuis A$ (Cell(2,1)
        'Jusqu'a la dernière cellule remplie en colonne T .Cells(.Rows.Count, 20).End(3))
        T = .Range(.Cells(2, 1), .Cells(.Rows.Count, 20).End(3))
    End With
        
    'Pour chaque ligne de notre tableau
    For i = LBound(T, 1) To UBound(T, 1)
        'Si la valeur en colonne 1 est égale au code choisi
        If CStr(T(i, 3)) = CodePdV Then
            'On incréménte j
            j = j + 1
            'L'entrée J du dictionnairte est égale aux valeurs ligne i colonne 11
            'et valeur ligne i colonne 20 de notre tableau
            D(j) = Array(T(i, 11), T(i, 20))
        'Fin de la condition
        End If
    'Prochaine ligne du tableau
    Next i
    'On vide la plage utilisée sur la feuille (UsedRange)
    Cells(3, 2).Resize(UsedRange.Rows.Count, 2).ClearContents
    ' si J > 0 (donc si il y a des entrées dans le dictionnaire
    If j Then
        'on colle les vbaleurs du dictionnaire
        Cells(3, 2).Resize(j, 2) = Application.Index(D.Items, , 0)
    'Sinon (si le dictionnaire est vide
    Else
        'On annonce la situation
        MsgBox "Pas de données pour ce code", 64, "Fin du traitement"
    'Fin de la condition des entrée du dictionnaire
    End If
'Fin de la condition du changement de cellule
End If
Next
End Sub
 
Vote positif 0 Vote négatif
gilbert_RGI

gilbert_RGI

XLDnaute Barbatruc
Re : Problème avec Pour adapter une macro

Bonjour

test30.gif

le programme bug aussi car il n'y a pas de données dans Vision PDV 1
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Problème avec Pour adapter une macro

Bonjour à tous,
Comme je suis l'auteur du code d'origine je me permet une ou deux remarques.
Thepower aurait pu finir le premier fil au lieu de tout laisser en plan.....

Pour le problème de For k = 0 To 2, remplacer l'instruction par
For k = Lbound(K) to Ubound(k)

Le nombre de feuille sera directement trouvé sans modification de code.

En mettant Set D = CreateObject("scripting.dictionary") à l'intérieur de la boucle, ça m'étonnerai que vous retrouviez les valeurs des premières feuilles......

C'était ma seule apparition sur ce fil, Thepower comprendra aisément que chat échaudé craint l'eau froide.

Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
197
job75
job75
G
  • Question
Microsoft 365 Macro VBA - Excel
Réponses
12
Affichages
242
Dranreb
Dranreb
M
  • Résolu(e)
Microsoft 365 Harmoniser la dénomination d'une cellule Recherche V d'un texte précis
Réponses
4
Affichages
307
mcfv
M
A
  • Résolu(e)
Microsoft 365 Copier la même cellule de plusieurs onglets dans différentes colonnes
2
Réponses
23
Affichages
824
AlexiaC
A
N
  • Résolu(e)
XL 2021 Somme cumulative en prenant en compte une colonne sur 3
Réponses
3
Affichages
109
NLSCt
N
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
529
sousou
sousou
M
  • Question
Microsoft 365 calcul pour classement Lycée UNSS
Réponses
5
Affichages
119
moupa
M
C
  • Question
XL 2013 comment copier une mise en forme automatiquement avec une formule ?
Réponses
6
Affichages
462
fanch55
fanch55
F
  • Question
XL 2021 Présenter des convocations à partir de 'calendrier' ?
Réponses
8
Affichages
301
fanou06
F
R
  • Résolu(e)
Autres Problème de duplication de boutons
Réponses
3
Affichages
82
fanfan38
fanfan38

Membres actuellement en ligne

Aucun membre en ligne actuellement.
2 membres et 48 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 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16