Accelerer code et refaire au cas ou

bonjour

je souhaite accélérer mon code

en sachant que les couleur c'est juste pour le test et que les colonnes H a K aussi

Où ai-je encore fourré ma boule de cristal, dju!

Bonjour,

Mauvaise journée, ce jour.

Le Jardin des Plantes à Paris et +30°

Je tombe sur ce message et un constat !.. Me suis je trompé de forum ?

Moi, je suis pour la libération des lapins nains aux petites oreilles…

Et je tue tout tridactyle qui se présente à moi.

Certainement un coup de chaleur.

Cdlt.

bonjour

je souhaite seulement que l'on regarde mon code et que l'on me dise si je peux accélérer les calculs

j'ai mit des couleurs et des colonne pour que l'on puisse comprendre ce que je fais

je ne cherche pas a que l'on me refasse tous mais que l'on me dise comment faire

merci pour ceux qui pourrons m'aider

désolé mauvais fichier

Re,

Je titille évidemment.

Si ton problème est bien expliqué, il est déjà à moitié résolu…

Sinon, tu reformules.

Cdlt.

bonjour et merci

teste le fichier a la fin il y a un msgbox avec les valeurs obtenus

je cherche a accelerer si possible le code car le nombre de ligne va augmenter

sinon me donner juste les infos, les code qu'il faudrait utiliser et je cherche a modifier seul

par exemple j'ai les variables x , y et som peux t'on faire autrement pour l'intialisation et la remise a zero

Salut cisco,

j'avance mais c'est pas encore top et je n'ai plus le temps de finasser : suite ce soir.

J'obtiens 3 résultats identiques bien qu'en comparant les deux fichiers, les données sont dispersées de manière différente...

Chaque chose en son temps!

Un double-clic démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract, tFlag(1 To 4, 1 To 2) As Long, tString()
tString = Array("somme ligne 021COFCTRL & 021COFCOF  = ", "somme ligne 021COFCTRL & 021COFCOF & 021COFEMBA  = ", "somme ligne 021COFCTRL & 021COFEMBA  = ", "somme ligne 021COFCTRL   = ")
'
Cancel = True
'
iRowA = Range("A" & Rows.Count).End(xlUp).Row
tData = Range("A1:G" & iRowA + 1).Value
ReDim tExtract(UBound(tData, 1), 4)
'
For x = UBound(tData, 1) - 1 To 3 Step -1
    If tData(x, 1) = tData(x - 1, 1) Then
        If tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" And tData(x - 2, 2) = "021COFCOF" Then
            tFlag(1, 1) = tFlag(1, 1) + tData(x, 5)
            tFlag(1, 2) = tFlag(1, 2) + 1
            tExtract(x, 1) = tFlag(1, 1) / tFlag(1, 2)
        Else
            If tData(x, 2) = "021COFCTRL" And tData(x - 1, 2) = "021COFCOF" Then
                tFlag(2, 1) = tFlag(2, 1) + tData(x, 5)
                tFlag(2, 2) = tFlag(2, 2) + 1
                tExtract(x, 0) = tFlag(2, 1) / tFlag(2, 2)
            ElseIf tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" Then
                tFlag(3, 1) = tFlag(3, 1) + tData(x, 5)
                tFlag(3, 2) = tFlag(3, 2) + 1
                tExtract(x, 2) = tFlag(3, 1) / tFlag(3, 2)
            End If
        End If
    Else
        Erase tFlag
    End If
    If tData(x, 1) <> tData(x + 1, 1) And tData(x, 1) <> tData(x - 1, 1) And tData(x, 2) = "021COFCTRL" Then tExtract(x, 3) = tData(x, 5)
Next
Range("H2").Resize(UBound(tData, 1), 4).Value = tExtract
For x = 0 To 3
    sMsg = sMsg & tString(x) & WorksheetFunction.Sum(Range(Chr(72 + x) & "2:" & Chr(72 + x) & iRowA)) & IIf(x < 3, Chr(10) & Chr(10), "")
Next
MsgBox sMsg, vbInformation, "Calcul"
'
End Sub

A ce soir

bonjour et merci

donc j'ai effectué quelque modification et cela a l'air de fonctionner

j'ai donc en premier modifier cette ligne

tExtract(x - 2, 1)

pour que les valeurs se positionnent bien

ensuite rajout de varia = 1 pour ligne 021COFCTRL & 021COFCOF

j'ai mit couleur juste pour voir

peux tu m'expliquer le fonctionnement de ce code

merci encore

Salut cisco,

bien vu les corrections!

A 6.00 du mat', je n'avais plus bits en phase !

Le voici, en plus condensé, avec un petit nettoyage : module1, bouton et macros inutiles éliminés.

Un double-clic n'importe où sur la feuille 'Import' suffit à démarrer la macro!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract, tFlag(1 To 3, 1 To 2) As Long, tString(), iVaria%, iOK%
tString = Array("somme ligne 021COFCTRL & 021COFCOF  = ", "somme ligne 021COFCTRL & 021COFCOF & 021COFEMBA  = ", "somme ligne 021COFCTRL & 021COFEMBA  = ", "somme ligne 021COFCTRL   = ")
'
Cancel = True
'
iRowA = Range("A" & Rows.Count).End(xlUp).Row
tData = Range("A1:G" & iRowA + 1).Value
ReDim tExtract(UBound(tData, 1), 4)
'
For x = UBound(tData, 1) - 1 To 3 Step -1
    iOK = 0
    If tData(x, 1) = tData(x - 1, 1) Then
        If tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" And tData(x - 2, 2) = "021COFCOF" Then iOK = 2: iVaria = 1
        If tData(x, 2) = "021COFCTRL" And tData(x - 1, 2) = "021COFCOF" And iVaria = 0 Then iOK = 1
        If tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" And iOK = 0 Then iOK = 3
        If iOK > 0 Then tFlag(iOK, 1) = tFlag(iOK, 1) + tData(x, 5): tFlag(iOK, 2) = tFlag(iOK, 2) + 1: tExtract(x, iOK - 1) = tFlag(iOK, 1) / tFlag(iOK, 2)
    Else
        iVaria = 0: Erase tFlag
    End If
    If tData(x, 1) <> tData(x + 1, 1) And tData(x, 1) <> tData(x - 1, 1) And tData(x, 2) = "021COFCTRL" Then tExtract(x, 3) = tData(x, 5)
Next
Range("H2").Resize(UBound(tData, 1), 4).Value = tExtract
For x = 0 To 3
    sMsg = sMsg & tString(x) & WorksheetFunction.Sum(Range(Chr(72 + x) & "2:" & Chr(72 + x) & iRowA)) & IIf(x < 3, Chr(10) & Chr(10), "")
Next
MsgBox sMsg, vbInformation, "Calcul"
'
End Sub

T'expliquer ce que tu as corrigé comme un grand et donc... compris!?

Si tu veux :

• tData est le tableau reprenant les infos de base (colonnes [A:G] ;
• tExtract est un tableau préparé pour recevoir les calculs intermédiaires destinés à être collés dans les colonnes [H:K]

- Range("H2").Resize(UBound(tData, 1), 4).Value = tExtract

* on colle à partir de [H2] ;

* pas besoin de calculer la place nécessaire, RESIZE reprend le nombre de lignes de tData et tu sais que tu as 4 colonnes de résultats.

- sMsg = sMsg & tString(x) & WorksheetFunction.Sum(Range(Chr(72 + x) & "2:" & Chr(72 + x) & iRowA))

* là, je te laisse chercher un peu

A+

bonjour et merci

il y a un decalage entre la valeur dans une des colonnes H a K et la recherche

exemple A6-A7 la valeur en H devrait se trouver en H6 ou H7 le meilleur serait en face de 021COFCTRL la il se trouve en H9

je regarde de mon coté voir si j'y arrive

merci encore

J'ai réussi à re-faire la même erreur : tExtract(x,...)

tExtract(x-2,...)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract, tFlag(1 To 3, 1 To 2) As Long, tString(), iVaria%, iOK%
tString = Array("somme ligne 021COFCTRL & 021COFCOF  = ", "somme ligne 021COFCTRL & 021COFCOF & 021COFEMBA  = ", "somme ligne 021COFCTRL & 021COFEMBA  = ", "somme ligne 021COFCTRL   = ")
'
Cancel = True
'
iRowA = Range("A" & Rows.Count).End(xlUp).Row
tData = Range("A1:G" & iRowA + 1).Value
ReDim tExtract(UBound(tData, 1), 4)
'
For x = UBound(tData, 1) - 1 To 3 Step -1
    iOK = 0
    If tData(x, 1) = tData(x - 1, 1) Then
        If tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" And tData(x - 2, 2) = "021COFCOF" Then iOK = 2: iVaria = 1
        If tData(x, 2) = "021COFCTRL" And tData(x - 1, 2) = "021COFCOF" And iVaria = 0 Then iOK = 1
        If tData(x, 2) = "021COFEMBA" And tData(x - 1, 2) = "021COFCTRL" And iOK = 0 Then iOK = 3
        If iOK > 0 Then tFlag(iOK, 1) = tFlag(iOK, 1) + tData(x, 5): tFlag(iOK, 2) = tFlag(iOK, 2) + 1: tExtract(x - 2, iOK - 1) = tFlag(iOK, 1) / tFlag(iOK, 2)
    Else
        iVaria = 0: Erase tFlag
    End If
    If tData(x, 1) <> tData(x + 1, 1) And tData(x, 1) <> tData(x - 1, 1) And tData(x, 2) = "021COFCTRL" Then tExtract(x - 2, 3) = tData(x, 5)
Next
Range("H2").Resize(UBound(tData, 1), 4).Value = tExtract
For x = 0 To 3
    sMsg = sMsg & tString(x) & WorksheetFunction.Sum(Range(Chr(72 + x) & "2:" & Chr(72 + x) & iRowA)) & IIf(x < 3, Chr(10) & Chr(10), "")
Next
MsgBox sMsg, vbInformation, "Calcul"
'
End Sub

A+

vitesse et precipitation

2 choses qui ne vont pas bien ensemble

merci encore

je laisse encore ouvert car j'ai d'autre question en cours

merci curulis57

rebonjour

dans le meme principe

je souhaite extraire par apport au operateur

je bloque car je ne sais pas ou mettre la remise a zero avant chaque operateur

je souhaite également garder les premières extraction c'est a dire sans operateur comme au debut

Petit up