Automatiser une formule par VBA
Bonjour le forum,
Je cherche un moyen d'écrire une formule par VBA.
J'ai en B5:H5 des données que je veux utiliser grâce aux données présentes dans H12:N20.
Dans H13-N20, les résultats peuvent être soit 0 soit 1.
Je cherche un moyen de calculer dans le tableau présent dans Q13:W20 le résultat de la somme des jours =0 jusqu'au jour où le résultat dans H13-N20 =1
Exemples :
1. Si I13 = 1 et que dans la ligne 13 du tableau H13-N20, toutes les autres valeurs sont égales à 0 alors
R13 = 100%
2. Si I13 = 1 et K13=1 et que dans la ligne 13 du tableau H13-N20, toutes les autres valeurs sont égales à 0 alors
R13 = C5 + D5
T13 = E5 + F5 + G5 + H5 + B5
Chaque ligne est indépendante donc si I13 et K13 sont égaux à 1 cela ne sera pas forcément le cas pour la ligne 14.
Je veux calculer la somme des % entre le 1er jour où le résultat est égale à 1 et le J-1 du prochain jour où le résultat est égale à 1
Là où cela se complique, c'est s'il y a plus de valeurs égales à 1 mais j'aimerai appliquer la même logique.
Je met mon code pour avoir un aperçu. Je pense qu'il y a plus efficace mais je n'arrive pas à trouver la solution.
Sub test()
Dim x, y, yp
For x = 13 To dernligneREGLES
For y = 8 To 14
Cells(x, 15).Value = Cells(x, 15).Value + Cells(x, y).Value
Next y
Next x
For x = 13 To dernligneREGLES
For y = 17 To 23
If Cells(x, 15).Value = 0 Then
Cells(x, y).Value = 0
End If
Next y
Next x
For x = 13 To dernligneREGLES
For y = 17 To 23
If Cells(x, 15).Value = 1 Then
Cells(x, y).Value = Cells(x, y - 9).Value = 0
End If
Next y
Next x
Dim i As Variant
Dim ColonneX As Integer
Dim cel As Range
Dim Valeur(1)
Dim Valeur(2)
For Each i In Range(Cells(x, 8), Cells(dernligneREGLES, 14))
If i = 1 Then
Set cel = Cells.Find(what:=i)
ColonneX = cel.Column
V(i) = ColonneX
End If
Next i
'For x = V1 To V2
End Sub
Je remercie toute personne pouvant m'aider.
Cordialement
Salut Jeff,
mieux vaut tard que jamais, dit-on...
Un double-clic démarre la macro...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData1, tData2, tData3, dTot1#, dTot2#, iIdx%
'
Cancel = True
'
tData1 = Range("B5:H5").Value
tData2 = Range("H13:N20").Value
Range("Q13:W20").ClearContents
Range("Q13:W20").Interior.Color = xlNone
tData3 = Range("Q13:W20").Value
'
For x = 1 To UBound(tData2, 1)
dTot1 = 0: dTot2 = 0: iIdx = 0
For y = 1 To UBound(tData2, 2)
dTot1 = dTot1 + IIf(iIdx = 0 And tData2(x, y) = 0, tData1(1, y), 0) 'addition des % si "0" avant le 1er "1"
If tData2(x, y) = 1 Then 'si "1"...
If dTot2 > 0 Then 'si total % > 0, donc si déjà rencontré "1"
tData3(x, iIdx) = dTot2 * 100 'tableau 3 reçoit le résultat de ce "1"
Range("P" & x + 12).Offset(0, iIdx).Interior.Color = RGB(215, 215, 215) 'mise en couleur de ce "1"
End If
dTot2 = 0: iIdx = y 'remise à zéro du total % : retient l'index du "1"
End If
dTot2 = dTot2 + IIf(iIdx = 0, 0, tData1(1, y)) 'addition des % si "1" rencontré
If y = UBound(tData2, 2) Then 'si dernier jour...
dTot2 = dTot2 + dTot1 'dernière addition de %...
tData3(x, iIdx) = dTot2 * 100 'inscription du résultat dans le tableau 3
Range("P" & x + 12).Offset(0, iIdx).Interior.Color = RGB(215, 215, 215) 'mise en couleur
End If
Next
Next
Range("Q13:W20").Value = tData3 'affichage des résultats
'
End Sub
A+