Créer un tableau par VBA selon certaines conditions

Résolu

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention -
Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention - 4 mai 2022 à 10:20

Bonjour,

Est-ce que cela est possible de créer un tableau, par 1 programmation VBA, dans l'onglet DTR du fichier Tableau Final ok selon certaines conditions ?

1. le tableau de l'onglet "DTR" du fichier "Tableau Final ok" respecte le modèle de l'onglet modèle
2. Les informations du fichier "2200RISK_charg" doivent être intégré dans l'onglet DTR selon le modèle du tableau de l'onglet "Modèle" (pour les colonnes B,C et G Uniquement)
3. Les éléments de la colonne B se terminant par "RISK" du tableau du fichier "2200RISK_charg" doivent être placés en partie haute du tableau avec les informations correspondantes en colonne C et en colonne G
4. Les éléments de la colonne B se terminant par "OPPOR" du tableau du fichier "2200RISK_charg" doivent être placés en partie basse du tableau avec les informations correspondantes en colonne C et en colonne G
5. La programmation VBA intègre le fait que les informations du fichier "2200RISK_charg" peuvent être plus ou moins nombreuses (voir capture d'écran ci-dessous): il peut y avoir 6 OU 5 etc... lignes concernés par les RISK (contre 3 lignes dans mon exemple) + il peut y avoir 6 ou 5 etc... lignes concernés par les OPPOR (contre 3 lignes dans mon exemple)

Merci beaucoup pour votre aide.

J'ai joint les fichiers concernés
Le lien a été crée (Fichier 2200RISK_charg) : https://www.cjoint.com/c/LDwiD0l22PO
Le lien a été crée (Fichier Tableau Final ok) : https://www.cjoint.com/c/LDwiEVVwaAO

RESULTAT FINAL SOUHAITE

CAPTURE D'ECRAN DES FICHIERS JOINTS
fichier "2200RISK_charg"

fichier "Tableau Final ok" => Onglet Modele

fichier "Tableau Final ok" => Onglet DTR

Les informations du fichier "2200RISK_charg" peuvent être plus ou moins nombreuses en terme de nombre de lignes:

Configuration: Windows / Chrome 100.0.4896.127

A voir également:

Créer un tableau par VBA selon certaines conditions
Créer un compte google - Guide
Comment créer un groupe whatsapp - Guide
Tableau word - Guide
Créer un lien pour partager des photos - Guide
Trier un tableau excel - Guide

4 réponses

Réponse 1 / 4

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

fichier "2200RISK_charg" doivent être intégré dans l'onglet DTR
Ajoutees a celles qui sont deja dans DTR ou a la Place des ces infos?

Les formules Somme doivent-elles etre mise a jour?

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 2

J'ai essayé avec le codage ci-après mais cela ne fonctionne pas vraiment :

Option Explicit

Sub Extraire()
Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer
Set ws = ThisWorkbook.Worksheets("DTR")

With Sheets("coûts")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If cel.Offset(, 1) like "*RISK*" Then
dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("I" & dt) = cel.Offset(, 6)
End If

Next cel
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("coûts")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If cel.Offset(, 1) like "*OPPOR*" Then
dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("I" & dt) = cel.Offset(, 6)
End If

Next cel
End With

Réponse 2 / 4

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 2

Bonjour,

Merci Forum : j'ai obtenu la solution qui est le codage ci-après

For Each x In Workbooks
If x.Name Like "*RISK.*" Then
Application.Windows(x.Name).Activate: Exit For
End If
Next x

With Sheets("Coûts")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)
'''''''''''''''''''''''''' RISK '''''''''''''
If cel.Offset(, 1) Like "*RISK*" Then
dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("D" & dt) = cel.Offset(, 6) / 1000

ws.Range("F" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("I" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("G" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("J" & dt).Formula = ws.Range("D" & dt).Formula

End If

Next cel

End With
With ws
.Range("A" & dt + 1) = "Total RISK"
.Range("D" & dt + 1).Formula = "=sum(D8:D" & dt & ")"
.Range("F" & dt + 1).Formula = "=sum(F8:F" & dt & ")"
.Range("G" & dt + 1).Formula = "=sum(G8:G" & dt & ")"
.Range("J" & dt + 1).Formula = "=sum(J8:J" & dt & ")"
.Range("K" & dt + 1).Formula = "=sum(J8:J" & dt & ") - sum(G8:G" & dt & ")"
.Range("I" & dt + 1).Formula = ThisWorkbook.Sheets("Détail des risques").Range("I1").Formula
End With

''''''''' RAJOUT "A JUSTIFIER CDP"
''''''''' RAJOUT "A JUSTIFIER CDP"

With ws
dt = dt + 2
.Range("K" & dt).Formula = ThisWorkbook.Sheets("Détail des risques").Range("K1").Formula

End With
''''''''' RAJOUT "A JUSTIFIER CDP"
''''''''' RAJOUT "A JUSTIFIER CDP"

dt = dt + 4 '+4 à ajuster selon le nombre de lignes à insérer
Deb = dt 'sauvegarde de la première ligne pour les OPPORT

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''PARTIE OPPOR OPPOR OPPOR
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For Each x In Workbooks
If x.Name Like "*RISK.*" Then
Application.Windows(x.Name).Activate: Exit For
End If
Next x

With Sheets("Coûts")
For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)
'''''''''''''''''''''''''' OPPOR '''''''''''''
If cel.Offset(, 1) Like "*OPPOR*" Then

ws.Range("A" & dt) = cel.Offset(, 1)
ws.Range("B" & dt) = cel.Offset(, 2)
ws.Range("D" & dt) = cel.Offset(, 6) / 1000

ws.Range("F" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("I" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("G" & dt).Formula = ws.Range("D" & dt).Formula
ws.Range("J" & dt).Formula = ws.Range("D" & dt).Formula
dt = dt + 1
End If

Next cel
End With
With ws
.Range("A" & dt) = "Total OPPOR"
'''''''''''''''''''''' Il faut diviser par 2
.Range("D" & dt).Formula = "=sum(D" & Deb & ":D" & dt & ") /2"
.Range("F" & dt).Formula = "=sum(F" & Deb & ":F" & dt & ") /2"
.Range("G" & dt).Formula = "=sum(G" & Deb & ":G" & dt & ") /2"
.Range("J" & dt).Formula = "=sum(J" & Deb & ":J" & dt & ") /2"
.Range("K" & dt).Formula = "=sum(G" & Deb & ":G" & dt & ") /2 - sum(J" & Deb & ":J" & dt & ") /2"
.Range("I" & dt).Formula = ThisWorkbook.Sheets("Détail des risques").Range("I2").Formula
End With

Réponse 3 / 4

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 2

Bonjour,

Ajouter à la place des infos du tableau de l'onglet DTR
Les formules Somme doivent être mise à jour.

Merci

Réponse 4 / 4

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 2

Bonjour,

Ajouter à la place des infos du tableau de l'onglet DTR
Les formules Somme doivent être mise à jour.

Merci

Votre réponse