Macro pour remplir tableau

G

GhostInTheShell

XLDnaute Nouveau
Bonjour,

Dans le ficher joint, vous trouverez un onglet "Grid" qui doit se remplir en fonction des données de l'onglet "Risk Log". Or, quand j'exécute la macro, elle ne remplit que la case en bas à gauche et ne rapatrie pas les autres données dans les autres cases.

J'ai beau retourner le truc dans tous les sens, je n'arrive pas à voir le soucis.

Je vous remercie par avance pour votre aide.

Bien à vous

Ghost
 

Pièces jointes

  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    51.6 KB · Affichages: 39
  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    51.6 KB · Affichages: 54
  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    51.6 KB · Affichages: 45
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Re : Macro pour remplir tableau

Hello

Vive le mode pas à pas ;-)
en changeant les cellules (i,15) et (i,16) par (i,5) et (i,6) ;-)

Code: 
Sub copiecellule()
    Dim A, B As Worksheet
    Dim i As Integer
    Set A = Sheets("Risk Log")
    Set B = Sheets("Grid")
    
    For i = 6 To 500
    
        If A.Cells(i, 5) = "1" And A.Cells(i, 6) = "1" Then
            B.Cells(5, 3) = B.Cells(5, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "1" And A.Cells(i, 6) = "2" Then
            B.Cells(5, 4) = B.Cells(5, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "1" And A.Cells(i, 6) = "3" Then
            B.Cells(5, 5) = B.Cells(5, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "1" And A.Cells(i, 6) = "4" Then
            B.Cells(5, 6) = B.Cells(5, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "1" And A.Cells(i, 6) = "5" Then
            B.Cells(5, 7) = B.Cells(5, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "2" And A.Cells(i, 6) = "1" Then
            B.Cells(4, 3) = B.Cells(4, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "2" And A.Cells(i, 6) = "2" Then
            B.Cells(4, 4) = B.Cells(4, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "2" And A.Cells(i, 6) = "3" Then
            B.Cells(4, 5) = B.Cells(4, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "2" And A.Cells(i, 6) = "4" Then
            B.Cells(4, 6) = B.Cells(4, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "2" And A.Cells(i, 6) = "5" Then
            B.Cells(4, 7) = B.Cells(4, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "3" And A.Cells(i, 6) = "1" Then
            B.Cells(3, 3) = B.Cells(3, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "3" And A.Cells(i, 6) = "2" Then
            B.Cells(3, 4) = B.Cells(3, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "3" And A.Cells(i, 6) = "3" Then
            B.Cells(3, 5) = B.Cells(3, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "3" And A.Cells(i, 6) = "4" Then
            B.Cells(3, 6) = B.Cells(3, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "3" And A.Cells(i, 6) = "5" Then
            B.Cells(3, 7) = B.Cells(3, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "4" And A.Cells(i, 6) = "1" Then
            B.Cells(2, 3) = B.Cells(2, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "4" And A.Cells(i, 6) = "2" Then
            B.Cells(2, 4) = B.Cells(2, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "4" And A.Cells(i, 6) = "3" Then
            B.Cells(2, 5) = B.Cells(2, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "4" And A.Cells(i, 6) = "4" Then
            B.Cells(2, 6) = B.Cells(2, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "4" And A.Cells(i, 6) = "5" Then
            B.Cells(2, 7) = B.Cells(2, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "5" And A.Cells(i, 6) = "1" Then
            B.Cells(1, 3) = B.Cells(1, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "5" And A.Cells(i, 6) = "2" Then
            B.Cells(1, 4) = B.Cells(1, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "5" And A.Cells(i, 6) = "3" Then
            B.Cells(1, 5) = B.Cells(1, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "5" And A.Cells(i, 6) = "4" Then
            B.Cells(1, 6) = B.Cells(1, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        ElseIf A.Cells(i, 5) = "5" And A.Cells(i, 6) = "5" Then
            B.Cells(1, 7) = B.Cells(1, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        End If
    Next
        'If A.Cells(i, 15) = "2" And A.Cells(i, 16) = "**" Then
           ' B.Cells(n, 3) = B.Cells(n, 3) & Chr(10) & A.Cells(i, 4) & " " & A.Cells(i, 5)
            'n = n + 1
           
        
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Macro pour remplir tableau

pour débugger un code, c'est la seule solution pratique.. tu checkes les lignes une par une.. comme c'est ton code, tu sais ce qu'elle est censée faire. et si le résultat n'est pas celui attendu, c'est qu'il y a une erreur

sinon, autre solution de code pour éviter les 50 000 else if assez dur à lire: utilise le select case
Code: 
Sub copiecellule()
    Dim A, B As Worksheet
    Dim i As Integer
    Set A = Sheets("Risk Log")
    Set B = Sheets("Grid")
    nb = A.Range("A" & Range("A:A").Count).End(xlUp).Row
    
    For i = 6 To nb
        code = A.Cells(i, 5) * 10 + A.Cells(i, 6)
        
        Select Case code
        Case 11
            B.Cells(5, 3) = B.Cells(5, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 12
            B.Cells(5, 4) = B.Cells(5, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 13
            B.Cells(5, 5) = B.Cells(5, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 14
            B.Cells(5, 6) = B.Cells(5, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 15
            B.Cells(5, 7) = B.Cells(5, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 21
            B.Cells(4, 3) = B.Cells(4, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 22
            B.Cells(4, 4) = B.Cells(4, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 23
            B.Cells(4, 5) = B.Cells(4, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 24
            B.Cells(4, 6) = B.Cells(4, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 25
            B.Cells(4, 7) = B.Cells(4, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 31
            B.Cells(3, 3) = B.Cells(3, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 32
            B.Cells(3, 4) = B.Cells(3, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 33
            B.Cells(3, 5) = B.Cells(3, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 34
            B.Cells(3, 6) = B.Cells(3, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 35
            B.Cells(3, 7) = B.Cells(3, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 41
            B.Cells(2, 3) = B.Cells(2, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 42
            B.Cells(2, 4) = B.Cells(2, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 43
            B.Cells(2, 5) = B.Cells(2, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 44
            B.Cells(2, 6) = B.Cells(2, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 45
            B.Cells(2, 7) = B.Cells(2, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 51
            B.Cells(1, 3) = B.Cells(1, 3) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 52
            B.Cells(1, 4) = B.Cells(1, 4) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 53
            B.Cells(1, 5) = B.Cells(1, 5) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 54
            B.Cells(1, 6) = B.Cells(1, 6) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        Case 55
            B.Cells(1, 7) = B.Cells(1, 7) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
        
        End Select
    Next i
End Sub

et je suis sur qu'avec une "simple" formule dans ton Grid, tu n'as pas besoin de code VBA
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Macro pour remplir tableau

avec formule matricielle ;-)
 

Pièces jointes

  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    48.2 KB · Affichages: 31
  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    48.2 KB · Affichages: 43
  • Template-M-A-PM-Issue-Action-Risk-Tracking-Logs.xlsm
    48.2 KB · Affichages: 43
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Macro pour remplir tableau

Bonjour à tous :),

Le code de vgendron simplifié

Code: 
Sub copiecellule()    
Dim A, B As Worksheet
    Dim i As Integer
    Set A = Sheets("Risk Log")
    Set B = Sheets("Grid")
    nb = A.Range("A" & Range("A:A").Count).End(xlUp).Row
    
    For i = 6 To nb
        lig = 6 - A.cells(i,5)
        col = A.cells(i,6) + 2
            B.Cells(lig, col) = B.Cells(lig, col) & Chr(10) & A.Cells(i, 3) & " " & A.Cells(i, 4)
    Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
G

GhostInTheShell

XLDnaute Nouveau
Comme ça, ça me semble mieux mais ça à l'air de mouliner beaucoup
Sub IDR()

Dim A As Worksheet
Dim I As Integer
Set A = Sheets("calcul")

For I = 2 To 20000

If A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 2 Then
Range("v2").FormulaR1C1 = "(A.Cells(I, 19)) * ((0))"
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 10 Then
Range("v2").FormulaR1C1 = " (A.Cells(I, 19) - 2) * ((1.5 / 10))"
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) > 10 Then
Range("v2").FormulaR1C1 = " = ((A.Cells(I, 19) - 2) * ((1.5 / 10)) + (A.Cells(I, 19) - 10) * ((3 / 10)))"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 2 Then
Range("v2").FormulaR1C1 = " = (A.Cells(I, 19)) * ((0))"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 10 Then
Range("v2").FormulaR1C1 = " = (A.Cells(I, 19) - 2) * ((1 / 10))"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) > 10 Then
Range("v2").FormulaR1C1 = " = ((A.Cells(I, 19) - 2) * ((1 / 10)) + (A.Cells(I, 19) - 10) * ((1.5 / 10)))"
ElseIf A.Cells(I, 16) = "TPO" And A.Cells(I, 19) < 10 Then
Range("v2").FormulaR1C1 = " = (A.Cells(I, 19)) * ((0))"

End If
Range("v2").AutoFill Destination:=Range("v2:v20000"), Type:=xlFillDefault
Next

End Sub
 
Vote positif 0 Vote négatif
Patrice33740

Patrice33740

XLDnaute Impliqué
Bonjour,

Au lieu de faire :
Code: 
Range("v2").FormulaR1C1 = formule
Range("v2").AutoFill Destination:=Range("v2:v20000"), Type:=xlFillDefault
Il suffit de faire directement :
Code: 
Range("v2:v20000").FormulaR1C1 = formule
mais attention, il faut préciser où se situe le Range :
Code: 
A.Range("v2:v20000").FormulaR1C1 = formule

Pour connaître la syntaxe R1C1 d'un formule, tu peux écrire la formule dans une cellule et faire
Code: 
MsgBox ActiveCell.FormulaR1C1
 
Vote positif 0 Vote négatif

Discussions similaires

K
  • Résolu(e)
Microsoft 365 Impression d'un tableau sans cases vides
Réponses
13
Affichages
460
KadNes
K
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
215
zendb
Z
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
390
job75
job75
C
  • Question
XL 2021 VBA - créer une boucle de calcul pour remplir un tableau à partir de 2 autres sur une même feuille
Réponses
7
Affichages
480
clineM
C
Nadou69
  • Résolu(e)
XL 2019 Erreur dans ma macro
Réponses
9
Affichages
253
Nadou69
Nadou69
G
  • Question
XL 2016 comment regrouper les données de plusieurs feuille dans une seule par une macro
Réponses
4
Affichages
579
GUEWOU
G
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb
Simbaa
  • Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
513
job75
job75
I
  • Résolu(e)
Microsoft 365 Changer la reference d'une etiquette automatiquement chaque semaine
Réponses
3
Affichages
526
ilyes4205
I
E
  • Question
XL 2021 Identifier de manières fiables les colonnes d'un fichier Excel pour une macro VBA
Réponses
2
Affichages
375
excelentille
E

Membres actuellement en ligne

11 membres et 71 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 094
Messages
2 105 816
Membres
109 431
dernier inscrit
jalilox25