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