Autres Alimentation feuille à partir d'une BDD sous condistions VBA Excel

W

wafaekam

XLDnaute Nouveau
Bonjour le forum, Je reviens vers vous parce que j’ai un truc à coder en VBA excel et je suis débutante la dessus.

En fait je souhaite en cliquant sur le bouton MAJ fichier :

Vérifier tout d’abord si les valeurs de la « col3 » et « col4 » de la feuille « BDD » existent dans la feuille réception. Exemple pour la 2eme ligne de mon fichier si j’ai la valeur NUM1 dans la col4 et la valeur AA dans la col3, je cherche alors dans la colonne AA de la feuille « reception » si j’ai bien NUM1 ou pas, et puis mettre reçu ou pas reçu dans la colonne « col13 » de la feuille « BDD » selon si la valeur existe ou pas.

Une fois c’est fait je souhaite alimenter la feuille « planning » à partir de la feuille « BDD », je veux parcourir la colonne A de la feuille « planning « et vérifier si la valeur existe dans la col4 de la feuille « BDD » et si la valeur de col3 feuille BDD égale à la valeur de l’entête (en jaune) de la feuille planning. Si case milieu est vide et valeur col13 BDD égale à « reçu » => affecter comme indiquer dans l’entête de la ligne 2 de la feuille planning et colorer les trois cases en vert. Si case milieu est vide et val col13 égale à « pas recu » => affecter et colorer les cases en orange.

Si case non vide vérifier si la couleur est orange si oui vérifier si le statut est passé en reçu sur la col13 de la feuille « BDD » si oui colorer les 3 cases en vert.

J’espère que j’ai pu expliquer en détail mon problème.

Je vous ai mis en PJ un fichier exemple illustrant un peu le problème.

N’hésitez pas si vous avez des questions, je suis débutante en VBA et j’ai vraiment besoin de votre aide

Je vous remercie énormément.
 

Pièces jointes

  • Fichier testwaf.xlsx
    19 KB · Affichages: 23
Trier par date Trier par votes
W

wafaekam

XLDnaute Nouveau
Bonjour, pourriez-vous m'aider SVP, j'ai essayé le code suivant et ça marche pas, je sais qu'il y a un problème dans la logique mais comme je suis débutante j'arrive pas à savoir ce qui cloche. Surtout qu'il m'affiche pas d'erreur mais plutôt le résultat qui est pas bon.

Private Sub CommandButton1_Click()
Set sh1 = Sheets("planning")
Set sh2 = Sheets("BBD")
Set sh3 = Sheets("Reception")
der_col = Cells.SpecialCells(xlCellTypeLastCell).Column
For i = 2 To sh1.Cells(Rows.Count, "A").End(xlUp).Row - 1
For k = 2 To sh3.Cells(Rows.Count, "A").End(xlUp).Row - 1
For j = 1 To der_col
'If Not IsError(Application.Match(Range("A" & i), sh2.Range("D:D"), 0)) Then

If sh2.Range("C" & i) = sh3.Cells(j, k) And sh2.Range("D" & i) = sh3.Range("A" & i) Then
sh2.Range("D" & i).Offset(0, 9) = "RECU"
Else
sh2.Range("D" & i).Offset(0, 9) = "PAS RECU"
End If
If sh1.Range("A" & i) = sh2.Range("D" & i) And sh2.Range("C" & i) = "AA" And sh1.Range("A" & i).Offset(0.2) = "" And sh2.Range("M" & i) = "RECU" Then

sh1.Range("A" & i).Offset(0, 1) = sh2.Range("D" & i).Offset(0, 6)
sh1.Range("A" & i).Offset(0, 2) = sh2.Range("D" & i)
sh1.Range("A" & i).Offset(0, 3) = sh2.Range("D" & i).Offset(0, 3)


End If
'End If
Next j
Next k
Next i

End Sub

merci d'avance
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour wafaekam
Petite question !
Dans quelle feuille veux tu déterminer la dernière colonne via cette procédure:
VB: 
der_col = Cells.SpecialCells(xlCellTypeLastCell).Column
car sous cette forme tu es dans la feuille "MAJ FICHIER"
ce qui dans
Code: 
For j = 1 To der_col
donne de for j= 1 to 1
jean marie
 
Vote positif 0 Vote négatif
W

wafaekam

XLDnaute Nouveau
Bonjour ChTi160,

Merci bien pour votre retour, oui effectivement vous avez raison c'était plutot la feuille reception et j'ai du changer et j'ai réussi par contre à avoir la deuxième partie de mon code . maintenant c'est la premiere partie qui permet de dire si c'est RECU ou PAS RECU qui me donne un faux résultat, voici le code que j'ai utilisé :
If sh2.Range("D" & ii) = sh3.Range("A" & k) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AA" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 1) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AB" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If

If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 2) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AC" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 3) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AD" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 4) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AE" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If

Merci d'avance
 
Vote positif 0 Vote négatif
W

wafaekam

XLDnaute Nouveau
Bonjour ,
Non c'est un nouveau code, il me disent que le fichier est trop volumineux donc j'arrive aps à le joindre. Je rejoute l'entete si ca peut aider, merci bien :

Set sh1 = Sheets("planning")
Set sh2 = Sheets("BBD")
Set sh3 = Sheets("Reception")

For i = 3 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
For ii = 2 To sh2.Cells(Rows.Count, "D").End(xlUp).Row
For k = 2 To sh3.Cells(Rows.Count, "A").End(xlUp).Row
If sh2.Range("D" & ii) = sh3.Range("A" & k) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AA" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 1) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AB" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If

If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 2) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AC" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 3) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AD" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 4) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AE" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If



merci bien
 
Vote positif 0 Vote négatif
W

wafaekam

XLDnaute Nouveau
Bonjour,


J'ai essayé de supprimer une grande partie du code et le fichier reste volumineux!!
Voici le code tel qu'il que j'ai dans la feuil1(MAJ FICHIER). Donc si possible SVP pourriez-vous le copier et coller dans la feuille en question ? Et le fichier serait le meme que celui que j'ai actuellement, j'en serai vraiment reconnaissante.
merci bien [U]ChTi160[/U].

Private Sub CommandButton1_Click()
Set sh1 = Sheets("planning")
Set sh2 = Sheets("BBD")
Set sh3 = Sheets("Reception")

For i = 3 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
For ii = 2 To sh2.Cells(Rows.Count, "D").End(xlUp).Row
For k = 2 To sh3.Cells(Rows.Count, "A").End(xlUp).Row

'If Not IsError(Application.Match(Range("A" & i), sh2.Range("D:D"), 0)) Then
If sh2.Range("D" & ii) = sh3.Range("A" & k) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AA" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 1) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AB" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If

If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 2) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AC" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 3) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AD" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If
If sh2.Range("D" & ii) = sh3.Range("A" & k).Offset(0, 4) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AE" Then
sh2.Range("M" & ii) = "RECU"
Else
sh2.Range("M" & ii) = "PAS RECU"
End If
End If

If sh1.Range("A" & i) = sh2.Range("D" & ii) Then
If sh2.Range("D" & ii).Offset(0, -1) = "AA" And sh2.Range("D" & ii).Offset(0, 9) = "RECU" Then

sh1.Range("A" & i).Offset(0, 1) = sh2.Range("D" & ii).Offset(0, 6).Value
sh1.Range("A" & i).Offset(0, 2) = sh2.Range("D" & ii)
sh1.Range("A" & i).Offset(0, 3) = sh2.Range("D" & ii).Offset(0, 3)
sh1.Range("A" & i).Offset(0, 1).Interior.Color = RGB(96, 224, 0)
sh1.Range("A" & i).Offset(0, 2).Interior.Color = RGB(96, 224, 0)
sh1.Range("A" & i).Offset(0, 3).Interior.Color = RGB(96, 224, 0)
Else
If sh2.Range("D" & ii).Offset(0, -1) = "AA" And sh2.Range("D" & ii).Offset(0, 9) <> "RECU" Then

sh1.Range("A" & i).Offset(0, 1) = sh2.Range("D" & ii).Offset(0, 6).Value
sh1.Range("A" & i).Offset(0, 2) = sh2.Range("D" & ii)
sh1.Range("A" & i).Offset(0, 3) = sh2.Range("D" & ii).Offset(0, 3)
sh1.Range("A" & i).Offset(0, 1).Interior.Color = RGB(224, 128, 32)
sh1.Range("A" & i).Offset(0, 2).Interior.Color = RGB(224, 128, 32)
sh1.Range("A" & i).Offset(0, 3).Interior.Color = RGB(224, 128, 32)
End If
End If
End If

Next k
Next ii
Next i

End Sub
 
Vote positif 0 Vote négatif
W

wafaekam

XLDnaute Nouveau
Bonjour [U]ChTi160,[/U]

Merci bien pour votre retour. oui l'objectif c'est d'afficher recu ou pas recu selon si la valeur existe dans la colonne A, B C ...Mais le problème est que le résultat il est parfois pas bon, genre ça doit être reçu et il me met pas reçu. Donc il y a surement un problème dans la logique de mes si imbriqués.
Pour le résultat obtenu, avez-vous réellement que trois valeurs dans la feuille réception?

Merci bien
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour wafarkam
Je ne comprends pas ta demande !
A partir de ton fichier (les tableaux) ,je n'avais
Que trois annotations ajoutées à la colonne "reçu" , "pas reçu"
D'où ma demande est ce que lors de la recherche on doit mettre systématiquement "non reçu" si pas trouvé ? (Comme dans la vidéo)
Je n'utilise pas la procédure de ton fichier.
J'ai du tout refaire pour cette partie.
Bonne journée
Jean marie
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2021 TCD / Interactions / sorties / gestion
Réponses
4
Affichages
161
MALTER
M
N
  • Question
Microsoft 365 Remplissage automatique d'une feuille à l'autre
Réponses
2
Affichages
177
Nonoo
N
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
1 K
Banbara
B
D
  • Question
Microsoft 365 Calcul à partir d'une table
Réponses
2
Affichages
230
DR85
D
C
  • Résolu(e)
Microsoft 365 Problème VBA lors de l'affichage de ligne masquée
2
Réponses
21
Affichages
612
Chris Linefield
C
N
  • Résolu(e)
XL 2013 Problème de formulation EXCEL
Réponses
3
Affichages
132
Ninoo82
N
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
329
Minus&Cortex
M
I
  • Question
XL 2016 Dupliquer des colonnes sur plusieurs feuilles
Réponses
2
Affichages
183
AtTheOne
AtTheOne
P
  • Résolu(e)
Microsoft 365 Rechercher une valeur d'une cellule à partir d'un nom de feuille
Réponses
2
Affichages
258
paulng
P
M
  • Question
XL 2019 Images dans plusieurs cellules à partir de plusieurs URL
2
Réponses
15
Affichages
748
patricktoulon
patricktoulon

Membres actuellement en ligne

2 membres et 44 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
314 708
Messages
2 112 097
Membres
111 416
dernier inscrit
philipperoy83