Sujet Précédent Sujet Suivant

Créer un tableau par VBA selon certaines conditions

Résolu/Fermé
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - Modifié le 22 avril 2022 à 11:03
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - 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:

4 réponses

Réponse 1 / 4
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
Modifié le 22 avril 2022 à 11:54
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?
1
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
Modifié le 22 avril 2022 à 15:22
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
0
Réponse 2 / 4
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
4 mai 2022 à 10:20
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
1
Réponse 3 / 4
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
Modifié le 22 avril 2022 à 12:19
Bonjour,

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

Merci
0
Réponse 4 / 4
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
22 avril 2022 à 12:20
Bonjour,

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

Merci
0

Discussions similaires

créer une adresse gmail pour une autre personne
Emma33000 -
Emma33000 -

2 réponses