Autres Mise à jour entre deux feuilles excel 2007

phil66

XLDnaute Junior
Bonjour,

J'ai deux feuilles d'un même classeur , une feuille "jour" et l'autre feuille "tarif".
Ces deux feuilles ont des données en commun : "REF" ; "DES"; "QTE" ; "PRIX".

J'aimerais que lorsque je modifie "QTE" ou "PRIX" dans la feuille "jour",
les mêmes cellules changent dans la feuille "tarif", et bien entendu dans la ligne correspondant à la
même "REF" uniquement.
Les lignes ne sont pas toujours correspondantes (ex B de jour n'est pas nécessairement B de tarif)

Mes connaissances n'étant pas extraordinaires, le plus simple sera le mieux.

Je joins le fichier reprenant la structure.

D'avance un grand merci.
 

Pièces jointes

  • essai modif tarif.xlsx
    9.9 KB · Affichages: 17
Solution
Dans ce fichier (2) j'ai modifié la macro pour traiter les nombres décimaux :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---listes dans la feuille jour---
tablo = Sheets("jour").UsedRange.Resize(, 4) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If x <> "" Then d(x) = tablo(i, 3) & Chr(1) & tablo(i, 4)
Next
If d.Count = 0 Then Exit Sub
'---tableau des résultats---
tablo = UsedRange.Resize(, 5) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If d.exists(x) Then
        s = Split(d(x), Chr(1))
        If IsNumeric(s(0)) Then tablo(i, 4) = CDbl(s(0))...

job75

XLDnaute Barbatruc
Bonsoir phil66, Phil69970,

@Phil69970 : c'est la feuille "tarif" qui dépend des données de la feuille "jour".

Comme en feuille "tarif" il y a des "REF" qui n'existent pas en feuille "jour" on ne peut pas utiliser des formules, il faut du VBA.

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "tarif" :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---listes dans la feuille jour---
tablo = Sheets("jour").UsedRange.Resize(, 4) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If x <> "" Then d(x) = tablo(i, 3) & Chr(1) & tablo(i, 4)
Next
If d.Count = 0 Then Exit Sub
'---tableau des résultats---
tablo = UsedRange.Resize(, 5) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If d.exists(x) Then
        s = Split(d(x), Chr(1))
        tablo(i, 4) = s(0)
        tablo(i, 5) = s(1)
    End If
Next
'---restitution---
UsedRange.Resize(, 5) = tablo
End Sub
La macro se déclenche quand on active la feuille.

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

A+
 

Pièces jointes

  • essai modif tarif(1).xlsm
    20.1 KB · Affichages: 4

phil66

XLDnaute Junior
Bonjour,

Job75, ta solution marche très bien, merci !

J'ai adapté le code VBA à un autre classeur quasi similaire sauf que :
la feuille qui correspond à la feuille "tarif" de l'exemple a des colonnes en plus et
que "REF" est en colonne 4 ; "QTE" en colonne 6 et "PRIX" en colonne 7. (il y a 7 colonnes en tout)
et la feuille "jour" est identique au premier exemple.

Cela fonctionne sauf que lorsque la "REF" est identique et que "QTE" ou "PRIX" ne changent pas, cela me modifie le format des chiffres en colonnes 6 et 7 dans la feuille "TARIF" (ils se décalent à gauche et passent de 2 décimales à une).
Je joints le code que j'ai modifié en annexe... Ai-je fait une erreur?

Merci d'avance
 

Pièces jointes

  • Private Sub Worksheet liste prix.docx
    11 KB · Affichages: 2

job75

XLDnaute Barbatruc
Dans ce fichier (2) j'ai modifié la macro pour traiter les nombres décimaux :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---listes dans la feuille jour---
tablo = Sheets("jour").UsedRange.Resize(, 4) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If x <> "" Then d(x) = tablo(i, 3) & Chr(1) & tablo(i, 4)
Next
If d.Count = 0 Then Exit Sub
'---tableau des résultats---
tablo = UsedRange.Resize(, 5) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If d.exists(x) Then
        s = Split(d(x), Chr(1))
        If IsNumeric(s(0)) Then tablo(i, 4) = CDbl(s(0)) Else tablo(i, 4) = s(0)
        If IsNumeric(s(1)) Then tablo(i, 5) = CDbl(s(1)) Else tablo(i, 5) = s(0)
    End If
Next
'---restitution---
UsedRange.Resize(, 5) = tablo
End Sub
 

Pièces jointes

  • essai modif tarif(2).xlsm
    20.5 KB · Affichages: 8

phil66

XLDnaute Junior
Bonjour,
Job75, ça marche impeccablement !
Le fichier word c'était juste au cas où il fallait vérifier mon erreur éventuelle
dans la modification que j'avais faite. Surtout que je ne suis pas spécialement doué dans
l'encodage.:rolleyes:
Mais grâce à des gens comme toi, j'essaie de comprendre et j'apprends sur le tas !

Un très bon dimanche et encore merci.
 

Discussions similaires

Réponses
2
Affichages
393

Statistiques des forums

Discussions
312 088
Messages
2 085 201
Membres
102 817
dernier inscrit
Nini668