[RESOLU]Récupérer des valeurs provenant d'une autre feuille - VB

T

Ternoise

XLDnaute Occasionnel
Bonsoir le Forum

Comment récupérer dans une feuille la somme de 2 cellules placées dans une autre feuille suivant 2 critères. Uniquement en VB.

Afin de mieux me faire comprendre, un fichier exemple

Merci beaucoup
David
 

Pièces jointes

  • Report.xls
    37.5 KB · Affichages: 58
Dernière édition:
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Bonsoir Ternoise,

Dans le code de la feuille "RECUP" :

Code: 
Private Sub Worksheet_Activate()
Dim tablo, ub&, t, Ncol%, i&, nom$, j%, dat As Date, k&
tablo = Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row)
ub = UBound(tablo)
t = [B36].Resize([B65536].End(xlUp).Row - 35, [IV36].End(xlToLeft).Column - 1)
Ncol = UBound(t, 2)
For i = 2 To UBound(t)
  nom = t(i, 1)
  For j = 2 To Ncol
    dat = t(1, j)
    For k = 1 To ub
      If tablo(k, 1) = nom And tablo(k, 2) = dat Then
        t(i, j) = ""
        If tablo(k, 8) <> "" Or tablo(k, 9) <> "" Then
          If IsNumeric(tablo(i, 8)) And IsNumeric(tablo(k, 9)) _
            Then t(i, j) = tablo(k, 8) + tablo(k, 9)
        End If
        Exit For
      End If
    Next
  Next
Next
[B36].Resize(UBound(t), Ncol) = t
[C37].Resize(UBound(t) - 1, Ncol - 1).NumberFormat = "0.00"
End Sub
Bonne nuit et A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Re,

J'avais mal placé le t(i, j) = "" :

Code: 
Private Sub Worksheet_Activate()
Dim tablo, ub&, t, Ncol%, i&, nom$, j%, dat As Date, k&
tablo = Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row)
ub = UBound(tablo)
t = [B36].Resize([B65536].End(xlUp).Row - 35, [IV36].End(xlToLeft).Column - 1)
Ncol = UBound(t, 2)
For i = 2 To UBound(t)
  nom = t(i, 1)
  For j = 2 To Ncol
    dat = t(1, j)
    t(i, j) = ""
    For k = 1 To ub
      If tablo(k, 1) = nom And tablo(k, 2) = dat Then    
        If tablo(k, 8) <> "" Or tablo(k, 9) <> "" Then
          If IsNumeric(tablo(i, 8)) And IsNumeric(tablo(k, 9)) _
            Then t(i, j) = tablo(k, 8) + tablo(k, 9)
        End If
        Exit For
      End If
    Next
  Next
Next
[B36].Resize(UBound(t), Ncol) = t
[C37].Resize(UBound(t) - 1, Ncol - 1).NumberFormat = "0.00"
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Re,

Je n'avais pas vu qu'il y a des formules en ligne 36, alors pour les conserver :

Code: 
Private Sub Worksheet_Activate()
Dim tablo, ub&, t, Ncol%, i&, nom$, j%, dat As Date, k&
tablo = Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row)
ub = UBound(tablo)
t = [B36].Resize([B65536].End(xlUp).Row - 35, [IV36].End(xlToLeft).Column - 1).Formula
Ncol = UBound(t, 2)
For i = 2 To UBound(t)
  nom = t(i, 1)
  For j = 2 To Ncol
    dat = Evaluate(t(1, j))
    t(i, j) = ""
    For k = 1 To ub
      If tablo(k, 1) = nom And tablo(k, 2) = dat Then
        If tablo(k, 8) <> "" Or tablo(k, 9) <> "" Then
          If IsNumeric(tablo(i, 8)) And IsNumeric(tablo(k, 9)) _
            Then t(i, j) = tablo(k, 8) + tablo(k, 9)
        End If
        Exit For
      End If
    Next
  Next
Next
[B36].Resize(UBound(t), Ncol) = t
[C37].Resize(UBound(t) - 1, Ncol - 1).NumberFormat = "0.00"
End Sub
A+
 
Vote positif 0 Vote négatif
T

Ternoise

XLDnaute Occasionnel
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Bonjour Job75

Tout est parfait dorénavant

J'ai changé cette ligne afin de limiter la "grandeur" du tableau car il y a des données sous le tableau et une somme en colonne Q que j'ai masquée et du coup mis mets formules en colonne R

t = [B36].Resize([B46].End(xlUp).Row - 35, [Q36].End(xlToLeft).Column - 1).Formula
Cliquez pour agrandir...

A première vu cela fonctionne super bien.

Une petite chose, à la place des 0 qui s'affiche, ne peut on pas avoir des cellules vides ? pour jouer dans l'esthétique !

Peux tu me mettre des explications de chaque ligne de code stp pour que je comprenne mieux le principe ?

Merci beaucoup de ton aide
David
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Re,

On peut aussi entrer les formules Excel avec SOMMEPROD :

Code: 
Private Sub Worksheet_Activate()
Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row).Name = "S"
With [C37].Resize([B65536].End(xlUp).Row - 36, [IV36].End(xlToLeft).Column - 2)
  .NumberFormat = "0.00;-0.00;" 'masque les zéros
  .FormulaR1C1 = "=SUMPRODUCT((INDEX(S,,1)=RC2)*(INDEX(S,,2)=R36C),INDEX(S,,8)+INDEX(S,,9))"
  .Value = .Value 'supprime les formules
End With
ThisWorkbook.Names("S").Delete 'supprime le nom défini
End Sub
Le code est bien plus simple mais l'exécution est moins rapide sur de grands tableaux.

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Re,

S'il y a des textes dans les colonnes J ou K de la feuille DIRECTION, la macro précédente met des #VALEUR! dans tout le tableau.

L'utilisation de la fonction SOUS.TOTAL évite cet écueil :

Code: 
Private Sub Worksheet_Activate()
Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row).Name = "S"
With [C37].Resize([B65536].End(xlUp).Row - 36, [IV36].End(xlToLeft).Column - 2)
  .NumberFormat = "0.00;-0.00;" 'masque les zéros
  .FormulaR1C1 = "=SUMPRODUCT((INDEX(S,,1)=RC2)*(INDEX(S,,2)=R36C),SUBTOTAL(9,OFFSET(S,ROW(S)-9,7,1,2)))"
  .Value = .Value 'supprime les formules
End With
ThisWorkbook.Names("S").Delete 'supprime le nom défini
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Report(1).xls
    57 KB · Affichages: 41
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Récupérer des valeurs provenant d'une autre feuille - VB

Re,

C'est une formule classique d'Excel, pour la voir mettre en commentaires les 2 lignes qui suppriment les formules et le nom défini.

INDEX(S;;1) est la référence de la 1ère colonne de la plage S.

A+
 
Vote positif 0 Vote négatif
T

Ternoise

XLDnaute Occasionnel
Re : [RESOLU] Récupérer des valeurs provenant d'une autre feuille - VB

Re

Dans la feuille "DIRECTION" J'ai des données dans la colonne B et de L à R

Cela change t-il si un filtre est construit ?

J'avais donc changé
Sheets("DIRECTION").Range("C9:K" & Sheets("DIRECTION").[C65536].End(xlUp).Row).Name = "S"
Cliquez pour agrandir...

avec

Sheets("DIRECTION").Range("B9:R" & Sheets("DIRECTION").[C65536].End(xlUp).Row).Name = "S"
Cliquez pour agrandir...

mais je pense qu'il faut également changer cette ligne

.FormulaR1C1 = "=SUMPRODUCT((INDEX(S,,1)=RC2)*(INDEX(S,,2)=R36C), SUBTOTAL(9,OFFSET(S,ROW(S)-9,7,1,2)))"
Cliquez pour agrandir...

A bientôt de te lire
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Power Query Récupérer une donnée dans des classeurs pour afficher le résultat dans un autre classeur
Réponses
5
Affichages
217
hijackfr
H
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
226
phoceenjo
P
A
  • Question
XL 2016 Récupérer des valeurs dans un commentaire
Réponses
3
Affichages
189
Phil69970
Phil69970
M
  • Question
XL 2010 Récupération de données et les transformer avec Power Query ?
Réponses
3
Affichages
251
DJunqueira
D
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
1 K
Hutchy33
H
D
  • Résolu(e)
Microsoft 365 grouper les valeurs
Réponses
8
Affichages
216
Diane272727
D
B
  • Question
XL 2021 Reporter valeur d'une cellule sur 2
Réponses
2
Affichages
137
job75
job75
F
  • Question
XL 2019 Extraire des lignes suivant somme des colonnes pour alimenter un autre tableau
Réponses
1
Affichages
222
fanfan38
fanfan38
O
  • Question
XL 2021 Mise à jour automatique d'une feuille à partir d'une autre
Réponses
9
Affichages
352
Oca
O
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
229
Akortys
Akortys

Membres actuellement en ligne

15 membres et 249 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 198
Messages
2 086 114
Membres
103 121
dernier inscrit
SophieS