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 Sub

Bonjour

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

18statsl.zip (46.21 Ko)

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 Sub

Pas 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+

7statsl-2.zip (56.99 Ko)

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").Copy

Mets 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 If

Tu peux désactiver cette ligne ou mieux la mettre à la fin du code

Application.CutCopyMode = False

Si 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+

11statsl.xlsm (64.07 Ko)

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 If

Amicalement

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 = 8

et 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    10

je 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 Sub

A 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+

Rechercher des sujets similaires à "macro automatique"