{VBA Excel} Simplifier une macro avec une copie

Version imprimable

J'ai une macro qui compte ma production et arrive tous les 3000 tonnes je crée une message box

au debut je voulais créer un journal de bord sur un fichier word
mais j'ai un bug informatique dans ma boite qui fous le bordel sur tous le réseau

donc pour contourner le probleme
je voudrais a la place d'une message box
faire un journal de bord sur une autre feuille d'excel sur le meme classeur
sous la forme

date de fabrication numero de lots quantite fabrique

c'est 3 parametres ce situe sur une feuille nommé Saisie
date de fabrication est dans la colonne I sous la forme jj/mm hh:mm
numero de lots colonne Q
quantite fabrique correpsond a "poids" dans ma macro

j'ai mis en rouge ma message box
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Sub compter() Dim totlig As Long, poid As Double, i As Long With Sheets("Saisie") ' Travaille sur la feuille Saisie totlig = .Range("Q65536").End(xlUp).Row ' Recupere le nombre de ligne poid = 0# ' Initialise le poid calculé For i = 5 To totlig ' Demarre la boucle à la igne 5, la 1,2,3,4 sont des titres If IsNumeric(Range("Q" & i).Value) Then poid = poid + (.Range("Q" & i).Value / 1000) ' additione la valeur poids ramenée en tonnes End If If poid >= 3000 Then ' test avec la prochaine valeur si ca depasse les 3000 tonnes MsgBox ("Depassement :" & poid & " Kg" & vbCr & "A la ligne " & i) .Range("Q" & i).Interior.ColorIndex = 3 ' je colorie en rouge la cellule poid = 0# ' remise à zero des calculs Else .Range("Q" & i).Interior.ColorIndex = xlNone ' sinon j'enleve la couleur End If Next i End Sub
si vous pouvez m'aiguiller pour commencer
je vous en remercie d'avance

Teste ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub compter()
Dim totlig As Long, poid As Double, i As Long
    With Sheets("Saisie") ' Travaille sur la feuille Saisie
        totlig = .Range("Q65536").End(xlUp).Row ' Recupere le nombre de ligne
        poid = 0# ' Initialise le poid calculé
        For i = 5 To totlig ' Demarre la boucle à la igne 5, la 1,2,3,4 sont des titres
            If IsNumeric(Range("Q" & i).Value) Then
                poid = poid + (.Range("Q" & i).Value / 1000) ' additione la valeur poids ramenée en tonnes
                If poid >= 3000 Then ' test avec la prochaine valeur si ca depasse les 3000 tonnes
                    MsgBox ("Depassement :" & poid & " Kg" & vbCr & "A la ligne " & i)
                    .Range("Q" & i).Interior.ColorIndex = 3 ' je colorie en rouge la cellule
                    poid = 0# ' remise à zero des calculs
                  Else
                    .Range("Q" & i).Interior.ColorIndex = xlNone ' sinon j'enleve la couleur
                End If
            End If
        Next i
    End With
End Sub

J'ai inséré le message dans la condition if is numeric et surtout j'ai ajouté End With qui devait te gérérer une erreur ;)
A+

Bonjour thomas

je crois reconnaitre cette macro : Poids = 0# le # n'est pas commun utilisé par les vieux lol)

on va donc creer une feuille : "Rapport" et utiliser la colonne A

Citation:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub compter()
Dim totlig As Long, poid As Double, i As Long
With Sheets("Saisie") ' Travaille sur la feuille Saisie
totlig = .Range("Q65536").End(xlUp).Row ' Recupere le nombre de ligne
poid = 0# ' Initialise le poid calculé
For i = 5 To totlig ' Demarre la boucle à la igne 5, la 1,2,3,4 sont des titres
        If IsNumeric(Range("Q" & i).Value) Then
        poid = poid + (.Range("Q" & i).Value / 1000) ' additione la valeur poids ramenée en tonnes
        End If
If poid >= 3000 Then ' test avec la prochaine valeur si ca depasse les 3000 tonnes
sheets("Rapport").range("A" & sheets("Rapport").range("A65536").end(xlup).row +1) = "Depassement :" & poid & " Kg" & "A la ligne " & i
.Range("Q" & i).Interior.ColorIndex = 3 ' je colorie en rouge la cellule
poid = 0# ' remise à zero des calculs  
Else        
.Range("Q" & i).Interior.ColorIndex = xlNone ' sinon j'enleve la couleur    
End If
Next i
end with
End Sub

bonne journée ;)

Wilfried ton code marche pratiquement
il y a juste 2-3 ptits trucs qui m'embete et un autre plus gros

d'abord le plus gros
quand je lance la macro il excute bien ma demande mais quand je la relance a nouveau il va tout recopier pas recommencer a la suite
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Depassement :3006,6 KgA la ligne 694 Depassement :3002,53 KgA la ligne 1190 Depassement :3003,94 KgA la ligne 1667 Depassement :3031,1 KgA la ligne 2146 Depassement :3000 KgA la ligne 2177 Depassement :3000 KgA la ligne 2208 Depassement :3031,937 KgA la ligne 2235 Depassement :3605,392 KgA la ligne 2246 Depassement :3088,95 KgA la ligne 2262 Depassement :3030 KgA la ligne 2276 Depassement :3000 KgA la ligne 2287 Depassement :3000 KgA la ligne 2298 Depassement :3000 KgA la ligne 2309 Depassement :3000 KgA la ligne 2320 Depassement :3000 KgA la ligne 2339 Depassement :3007,896 KgA la ligne 2378 Depassement :3006,6 KgA la ligne 694 Depassement :3002,53 KgA la ligne 1190 Depassement :3003,94 KgA la ligne 1667 Depassement :3031,1 KgA la ligne 2146 Depassement :3000 KgA la ligne 2177 Depassement :3000 KgA la ligne 2208 Depassement :3031,937 KgA la ligne 2235 Depassement :3605,392 KgA la ligne 2246 Depassement :3088,95 KgA la ligne 2262 Depassement :3030 KgA la ligne 2276 Depassement :3000 KgA la ligne 2287 Depassement :3000 KgA la ligne 2298 Depassement :3000 KgA la ligne 2309 Depassement :3000 KgA la ligne 2320 Depassement :3000 KgA la ligne 2339 Depassement :3007,896 KgA la ligne 2378
moi je voudrais si possible qu'as chaque fois je lance la copie il ne me recopie pas tous au sinon ca va devenir un vrai bordel

mais pour mes 2/3 ptis trucs
pour recopier la date ou le numero de lots
j'ai juste a adpater ce code

Code:

Sheets("az").Range("A" & Sheets("az").Range("A65536").End(xlUp).Row + 1) = "Depassement :" & poid & " Kg" & "A la ligne " & i

et mettre un AND a la suite pour faire apparaitre mon numero de lots et ma date?

re:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub compter()
Dim totlig As Long, poid As Double, i As Long
With Sheets("Saisie") ' Travaille sur la feuille Saisie
totlig = .Range("Q65536").End(xlUp).Row ' Recupere le nombre de ligne
poid = 0# ' Initialise le poid calculé
Sheets("Rapport").range("A:A").clearcontents
For i = 5 To totlig ' Demarre la boucle à la igne 5, la 1,2,3,4 sont des titres
        If IsNumeric(Range("Q" & i).Value) Then
        poid = poid + (.Range("Q" & i).Value / 1000) ' additione la valeur poids ramenée en tonnes
        End If
If poid >= 3000 Then ' test avec la prochaine valeur si ca depasse les 3000 tonnes
sheets("Rapport").range("A" & sheets("Rapport").range("A65536").end(xlup).row +1) = "Depassement :" & poid & " Kg" & "A la ligne " & i
.Range("Q" & i).Interior.ColorIndex = 3 ' je colorie en rouge la cellule
poid = 0# ' remise à zero des calculs  
Else        
.Range("Q" & i).Interior.ColorIndex = xlNone ' sinon j'enleve la couleur    
End If
Next i
end with
End Sub

21/06/2007, 14h24
Thomas69

tu as tous resolu

merci pour tous

pour le reste j'ai adpater
21/06/2007, 14h35
wilfried_42

re:

Citation:

Sheets("Rapport").Range("A" & Sheets("Rapport").Range("A65536").End(xlUp).Row + 1) = "Depassement :" & poid & " Kg" & "A la ligne " & i
Sheets("Rapport").Range("B" & Sheets("Rapport").Range("A65536").End(xlUp).Row) = Range("M" & i)

il semblerait qu'il y ait des trous dans les données, avec la modif en rouge, les renseignement de la colonne M seront alignés avec les depassements de capacité

de plus n'oublie pas de modifier le

Code:

Sheets("Rapport").range("A:A").clearcontents

en :

Code:

Sheets("Rapport").range("A:B").clearcontents
21/06/2007, 14h38
Thomas69

c'est bon j'ai trouver par moi meme ;)

merci beaucoup pour ton aide ainsi qu'as ouskel