Macro automatique
bonjour le forum
j'ai fait une macro çi-dessous et j'aimerais quelle c'éxécute plusieurs fois de suite jusqu'a la fin de la base de données qui est en H34:L200,mais lorsqu'elle c'est éxécuter la premiere fois elle passe a la ligne suivante dans la bdd.La elle prend la ligne H34:L34,la copie,la range et puis efface cette ligne H34:L34,pour la fois suivante elle prendra la ligne H35:L35,la copie ,la range puis éfface la ligne H35:L35 et continue son éxécution et ainsi de suite H36:L36,s'éxécute puisH37:L37 etc...
Mais comment inscrire cela dans le code.
merci
Range("H34:L34").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("H34:L34").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A6:B54").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-30
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("40").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("40").Sort.SortFields.Add Key:=Range("D6:D54"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("40").Sort
.SetRange Range("C6:D54")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Calculate
Calculate
Range("G5").Select
vLigne = Range("AD65536").End(xlUp).Row
vLigne = vLigne + 1
Range("C3:G3").Select
Application.CutCopyMode = False
Selection.Copy
Range("AD" & vLigne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G5").Select
Dim Cellule As Range
Dim Plage As Range
Dim i, l, c As Integer
i = 6
Set Plage = Range("C1:G1")
While IsEmpty(Range("A" & i)) = False
For Each Cellule In Plage
If Range(Cellule.Address).Value = Range("C" & i).Value Then
l = Range("E" & i).Value + 8
c = Range("F" & i).Value + 10
Cells(c, l) = Cells(c, l) + 1
End If
Next Cellule
i = i + 1
Wend
Range("G5").Select
End SubBonjour
Mets ton fichier en ligne. ce sera plus simple de corriger
A te relire
bonjour dan,le forum
voici un fichier que j'ai fait avec les 2 feuilles correspondantes
merci
Re,
faudrait que tu expliques mieux ton souci car là je ne comprends pas le pourquoi des intructions lorsque tu copies H34:L34 vers C1 etc...
Est-ce que tout le code est concerné ?
exemple : est-ce que tu dois toujours copier le Range("A6:B54") à chaque passage de copie de H x : Lx vers C1 ??
A te relire
re Dan,le forum
Quand je le fait manuellement
1)je prend H34:L34 je le copie en C1
2)j'éfface H34:L34,puis calcul
3)Je clique sur la macro 1
4)F9(calcul
5)F9
6)clique sur macro 2
7))clique sur macro 3
8)je prend une ligne plus bas H35:L35,je copie en C1
9)j'efface H35:L35
10)je change la valeur de la cellule B6.$B$2:$F$41 devient $B$3:$F$42.une ligne plus bas dans BdD
11)je recopie la cellule B6 jusqu'a B54
12)calcul
13)macro 1
calcul(pour la colonneE)
calcul(pour la colonneF)
puis macro 2,macro 3 et je recommence
Les seules valeurs qui change c'est en H:L et B:Fdes cellules B6 a B54
a+
Re,
Ok je vois que ta macro 4 reprend les macro 1 2 et 3
Essaie ta macro 4 comme ceci :
Sub Macro4()
' Macro4 - 40-Auto
Dim plg As Byte
Dim dlg As Integer, vligne As Integer
dlg = Range("L" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
For plg = 34 To dlg
With Range("H" & plg & ":L" & plg)
.Copy Range("C1")
.ClearContents
End With
Range("A6:B54").Copy
Range("C6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With ActiveWorkbook.Worksheets("40").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D6:D54"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("C6:D54")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Calculate
'Range("G5").Select
vligne = Range("AD65536").End(xlUp).Row + 1
Range("C3:G3").Copy
Range("AD" & vligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Cellule As Range
Dim Plage As Range
Dim i, l, c As Integer
i = 6
Set Plage = Range("C1:G1")
While IsEmpty(Range("A" & i)) = False
For Each Cellule In Plage
If Range(Cellule.Address).Value = Range("C" & i).Value Then
l = Range("E" & i).Value + 8
c = Range("F" & i).Value + 10
Cells(c, l) = Cells(c, l) + 1
End If
Next Cellule
i = i + 1
Wend
Next
Application.ScreenUpdating = False
Range("G5").Select
End SubPas eu le temps de vérifier mais pas sur que le "calculate" serve à quelque chose.
Si ok, merci de cloturer le fil en cliquant sur le V vert à coté du bouton EDITER
Amicalement
Amicalement
rebj Dan
il manque une étape dans le processus celle du changement des valeurs des cellules B2:B54.En effet pour avoir les bons résultats en col E et F il faut avoir le nombre de sortie de chaque numeros des 40 tirages précedent classé par ordre de sortie en D du plus petit nombre au plus grand,ces valeurs change chaque fois d'une ligne plus bas.Au départ elles sont col B6 "NB.SI(BdD!$B2:$F41;A6)"
dés que la macro est fini elle change en "NB.SI(BdD!$B3:$F42;A6)" ,une ligne plus bas.
Dans le code elles peuvent etre ajoutées soit en fin de code ou avant le "Range("A6:B54"). Copy.
j'ai refait une feuille avec la BdD sur la meme feuille si ça peut-etre plus facile pour le code
merci
a+
re,
dés que la macro est fini elle change en "NB.SI(BdD!$B3:$F42;A6)" ,une ligne plus bas.
Dans le code elles peuvent etre ajoutées soit en fin de code ou avant le "Range("A6:B54"). Copy
Je ne comprends pas bien le pourquoi et cette demande ne faisait pas partie de ta demande sur ce fil
Veux-tu dire qu'à chaque changement de la variable plg, la formule doit évoluer d'une ligne ??
NB.SI(BdD!$B3:$F42;A6)" -> NB.SI(BdD!$B4:$F43;A6)"
A te relire
bonjour Dan,le forum
effectivement, j'aurais du mieux le préciser dans le point 10, elle change chaque fois de une ligne plus bas.
NB.SI(BdD!$B3:$F42;A6) en NB.SI(BdD!$B4:$F43;A6)
mes excuses pour ces mauvaises explications
merci
a+
Re,
Juste avant
Range("A6:B54").CopyMets ce code
If plg > 34 Then
Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + 8 & ",$a6)"
Range("B6").AutoFill Destination:=Range("B6:B54"), Type:=xlFillDefault
End IfTu peux désactiver cette ligne ou mieux la mettre à la fin du code
Application.CutCopyMode = FalseSi ok, merci de cloturer le fil en cliquant sur le V vert à coté du bouton EDITER
Amicalement
bonjour Dan,le forum
il y a un probleme le code ne fonctionne bien que pour la premiere ligne aprés il ne s'inscrit que des 1
il semblerait que le tri des colonnes C6:D54" ne se fasse pas
je remet le fichier clique sur macro4 pour voir ce qui se passe
merci
a+
re,
Dans ton fichier tu as suspendu le calcul automatique.
Remplace le code proposé dans mon post précédent par celui ci-après
If plg > 34 Then
Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + 8 & ",$a6)"
Range("B6").AutoFill Destination:=Range("B6:B54"), Type:=xlFillDefault
Calculate
End IfAmicalement
bonjour Dan,le forum
c'est parfait,merci
une petite question,la je fais une analyse sur 40 tirages,si je veux la faire sur 50 tirages,que faut-il changer dans le code.
que signifie "-32"
merci
Re
une petite question,la je fais une analyse sur 40 tirages,si je veux la faire sur 50 tirages,que faut-il changer dans le code.
Change le chiffre 8 dans cette ligne --> Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + 8 & ",$a6)"
exemple si tu veux 50, ajoute 10. Donc 8 sera égal à 18.
Tu peux aussi en début de macro créér une variable (i par exemple qui reprend ce chiffre).
Exemple :
En début de code avant "application.screenup...3, tu mets
Dim i as byte
i = 8et dans cette ligne tu mets ceci
Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + i & ",$a6)"De cette sorte, si tu veux faire pour 50, tu changes i en début de code et tu le remplaces par 18.
que signifie "-32"
En fait si tu regardes ton tableau en ligne 34, tu as tes données. J'utilise donc cette ligne 34 pour la variable "plg"
Le 32 correspond au chiffre qui permet de construire ta formule.
Quand Plg vaut 34 (donnée sur ta ligne 34) dans la boucle, ta formule en B6 doit reprendre dans BdD la ligne 2 et la ligne 42
Quand Plg vaut 35 (donnée sur ta ligne 35) dans la boucle, ta formule en B6 doit débuter à la ligne 3 dans BdD(Soit 35-32 = 3) et ligne 43 (soit 35+8)
Espérant que tu as compris mes explications.
bonjour Dan,le forum
je viens de vérifier et il y a un probléme.
lorsque que je met 1 ou 2 ligne en H34,les résultat sont corrects mais si je met une centaine de lignes en H34 là les résultats sont faux seul les 2 premiers résultats sont juste.
Les données de la formule en B6 changent pour les 2 premieres ligne puis ne changent plus,c'est a dire au départ elles sont " $B$2:$F$51 " puis passent a " $B$3:$F$52 " puis aprés ne changent plus.
Comme la macro s'éxécute trés rapidement,la vitesse d'éxécution ne poserait-elle pas un probléme.
merci
a+
Re
Sur base de ton fichier avec des données entre H34 et H72 en feuille 40, J'ai exécuté le code pour 8 lignes(donc jusque la ligne 40). En B6 j'ai cette formule --> =NB.SI(BdD!$B$8:$F$48;$A6)
AS-tu bien ajouté le "Calculate" avant le END IF
Quel est le problème que tu vois ?
A te relire
bonjour Dan,le forum
l'erreur se fait dans les données inscrites en AD,les 5 colonnes de droite faites automatiquement,colonnes de gauche faites manuellement et controler une a une.Les 2 premieres lignes sont correctes
2 9 5 6 3 2 9 5 6 3
5 3 3 4 6 5 3 3 4 6
6 3 10 4 4 6 2 9 4 4
3 6 5 4 3 3 6 5 5 3
8 7 6 6 4 8 6 7 6 5
2 6 4 8 3 2 6 5 8 3
1 4 4 5 5 1 5 5 6 4
6 6 7 5 3
4 5 5 3 6
2 8 3 10 5
3 3 7 7 3
6 5 7 8 10je remet le code
Sub Macro4()
' Macro4 - 40-Auto
'
Dim plg As Byte
Dim dlg As Integer, vligne As Integer
dlg = Range("L" & Rows.Count).End(xlUp).Row
Dim t As Byte
t = 8
'inscription des données en C1 prises en H34
Application.ScreenUpdating = True
For plg = 34 To dlg
With Range("H" & plg & ":L" & plg)
.Copy Range("C1")
.ClearContents
End With
Calculate
'inscription des données en AD2
vligne = Range("AD65536").End(xlUp).Row + 1
Range("C3:G3").Copy
Range("AD" & vligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Calculate
'calcul et inscription des données dans le tableau H10
Dim Cellule As Range
Dim Plage As Range
Dim i, l, c As Integer
i = 6
Set Plage = Range("C1:G1")
While IsEmpty(Range("A" & i)) = False
For Each Cellule In Plage
If Range(Cellule.Address).Value = Range("C" & i).Value Then
l = Range("E" & i).Value + 8
c = Range("F" & i).Value + 10
Cells(c, l) = Cells(c, l) + 1
End If
Next Cellule
i = i + 1
Wend
Next
'changement de la formule en B6
If plg > 34 Then
Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + t & ",$A6)"
Range("B6").AutoFill Destination:=Range("B6:B54"), Type:=xlFillDefault
Calculate
End If
'calcul et tri des colonnes A6-F6
Range("A6:B54").Copy
Range("C6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With ActiveWorkbook.Worksheets("40").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D6:D54"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("C6:D54")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Calculate
Range("G5").Select
Application.CutCopyMode = False
End Sub
merci
a+
re
j'ai oublié de préciser que lorsque la BdD fait 100 lignes la formule en B6 devrait indiquer lorsqu'elle a terminé le traitement pour 50T " $B$51:F$100;A6 " or elle indique " $B$61:$F$111;A6 "
a+
re,
Dans le fichier que tu as posté sur le forum il ya un souci car le code que tu mets pour la macro 4 ici ne correspond pas à ce qui est dans ton fichier et à ce que tu as posté au début de ta demande.
Voici le code que j'utilise depuis le début et qui inclut les changements que je t'ai suggérés dans mes poste précédents.
Sub Macro4()
' Macro4 - 40-Auto
Dim plg As Byte
Dim dlg As Integer, vligne As Integer
dlg = Range("L" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
For plg = 34 To dlg
With Range("H" & plg & ":L" & plg)
.Copy Range("C1")
.ClearContents
End With
If plg > 34 Then
Range("B6") = "=COUNTIF(BdD!$B$" & plg - 32 & ":$F$" & plg + 8 & ",$a6)"
Range("B6").AutoFill Destination:=Range("B6:B54"), Type:=xlFillDefault
End If
Range("A6:B54").Copy
Range("C6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Application.CutCopyMode = False
With ActiveWorkbook.Worksheets("40").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("D6:D54"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("C6:D54")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Calculate
'Range("G5").Select
vligne = Range("AD65536").End(xlUp).Row + 1
Range("C3:G3").Copy
Range("AD" & vligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Cellule As Range
Dim Plage As Range
Dim i, l, c As Integer
i = 6
Set Plage = Range("C1:G1")
While IsEmpty(Range("A" & i)) = False
For Each Cellule In Plage
If Range(Cellule.Address).Value = Range("C" & i).Value Then
l = Range("E" & i).Value + 8
c = Range("F" & i).Value + 10
Cells(c, l) = Cells(c, l) + 1
End If
Next Cellule
i = i + 1
Wend
Next
Application.ScreenUpdating = False
Range("G5").Select
Application.CutCopyMode = False
End SubA te relire
re Dan
effectivement ce n'est pas tout a fait la meme,que de temps perdu avec mes mauvaises explications.
Dans mon post de départ le code est pour etre fait manuellement alors quand automatique le changement de formule et son tri se font a la fin.En automatique la formule au départ est bien " $B$2:$F$41;A6 " le tri de la colonne C/D est fait et les formules en E/F sont a jour.Alors quand je commence en auto la premiere chose qui se fait c'est l'incription en C1 de la ligne H34 puis calcul,envoi de la ligne C3 en AD2,puis les données dans le tableau H10 et aprés changement de la formule B6,calcul,tri calcul et de nouveau la ligne H35 en C1 si bien que lorsque la BdB est terminée la macro est prete pour recevoir une nouvelle ligne en c1..
C'est pour cela que dans le code j'ai passé la partie A6:F54 et le tri en dernier.
L'erreur viendrait de la.
encore mes excuses pour ce caffouillage.
merci
A+