Créer un tableau par VBA selon certaines conditions
Résolu
Dreampower75
Messages postés
91
Statut
Membre
-
Dreampower75 Messages postés 91 Statut Membre -
Dreampower75 Messages postés 91 Statut Membre -
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:
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
- Tableau word - Guide
- Comment créer un groupe whatsapp - Guide
- Créer un compte google - Guide
- Créer un lien pour partager des photos - Guide
- Trier un tableau excel - Guide
4 réponses
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?
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?
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
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
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