cathodique
XLDnaute Barbatruc
Bonjour tout le monde,
ce post est en relation avec mon précédent post ici, auquel je n'ai pas eu de retour. Je doute bien que malgré 2 posts, je ne suis pas parvenu à bien exposer mon problème.
Mes connaissances du VBA sont limitées, j'ai trouvé une solution par formule (Sommeprod) que j'ai introduite dans le code de récupération des données (même ce code n'est pas de moi, je remercie tous ceux qui m'ont aidé).
Dans ce code j'ai rajouté les 4 lignes avec formule sommeprod, j'obtiens bien le résultat escompté. Ce qui est gênant c'est de voir l’exécution du calcul cellule par cellule.
Pour éviter ceci, pourrait-on passer par un tableau temporaire afin que les calculs s'effectuent en mémoire?
Si oui, comment le faire? à moins que vous n'ayez une meilleure solution et plus adaptée.
En vous remerciant beaucoup.
Cordialement,
PS: J'ai nommée les colonnes de la feuille BD, ces noms sont utilisés dans la formule.
ce post est en relation avec mon précédent post ici, auquel je n'ai pas eu de retour. Je doute bien que malgré 2 posts, je ne suis pas parvenu à bien exposer mon problème.
Mes connaissances du VBA sont limitées, j'ai trouvé une solution par formule (Sommeprod) que j'ai introduite dans le code de récupération des données (même ce code n'est pas de moi, je remercie tous ceux qui m'ont aidé).
Code:
Sub Preparer_New()
Dim ligne As Long, j As Long, k As Long, Lastlig As Long
Dim i As Long
Dim o As Object, bd As Object
Dim Tb, Res()
Dim Dercol As Integer
Dim Val1 As String, Val2 As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Set bd = Sheets("Cordonnées") 'définit l'onglet bd
dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet bd
Set o = Sheets("Relevé")
'Dans la variable tableau Tb
With bd
Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:J" & Lastlig)
End With
With o
Dercol = o.Range("A5").End(xlToRight).Column
Val1 = .Range("B2") 'ouvrage
Val2 = .Range("B3") 'LIMITE
For i = 1 To Lastlig - 1
'
If Tb(i, 3) = Val1 And Tb(i, 4) = Val2 Then
j = j + 1
ReDim Preserve Res(1 To 12, 1 To j)
Res(1, j) = j
Res(2, j) = Round(Tb(i, 5), 2) 'PK
Res(3, j) = Tb(i, 6) 'type
Res(4, j) = "=IF((SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3)*val3))=0,"""",SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3)*val3))"
Res(5, j) = "=IF((SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3)*val4))=0,"""",SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3)*val4))"
Res(6, j) = Tb(i, 7) 'OUVRAGE VOISIN
Res(7, j) = Tb(i, 8) 'PK VOISIN
Res(8, j) = "=IF((SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3),(val1)))=0,"""",SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3),(val1)))"
Res(9, j) = "=IF((SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3),(val2)))=0,"""",SUMPRODUCT((Ref=R4C7)*(Date=R1C6)*(Ouvrage=RC6)*(Voisin=R2C2)*(Type=RC3),(val2)))"
Res(12, j) = Tb(i, 9) 'OBSERVATION
End If
Next i
Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
If Lastlig > 8 Then .Range("A8:L" & Lastlig).Clear
If j > 0 Then .Range("A8").Resize(j, 12) = Application.Transpose(Res)
.Range("A8").Resize(j, Dercol).Borders.Weight = xlThin
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End SubPour éviter ceci, pourrait-on passer par un tableau temporaire afin que les calculs s'effectuent en mémoire?
Si oui, comment le faire? à moins que vous n'ayez une meilleure solution et plus adaptée.
En vous remerciant beaucoup.
Cordialement,
PS: J'ai nommée les colonnes de la feuille BD, ces noms sont utilisés dans la formule.
