Appliquer un script à tous les classeur ouvert

Le 29/06/2021 à 13:55

Bonjour

Je cherche à appliquer mon script ci-dessous à tous les classeurs ouvert. En effet aujourd'hui je fais appelle avec with sheet("XXX") mais j'aimerais que ma macro lorsque je fais F5 s'applique à TOUS les classeur ouvert dans excel et je n'ai pas trouvé la solution sur le net.

J'aimerais faire cela afin de ne pas avoir à changer le nom du fichier à chaque fois dans le code.

merci et bonne journée

Sub precision_interne234U()

Dim j As Integer
Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moytest As Double
Dim SDtest As Double

With Sheets("017-IRMM100")

'on nomme les cellules de debut ou l'on mettra les différents résultat

    .Cells(57, 2) = "moyenne"
    .Cells(58, 2) = "StandDev(x2)"
    .Cells(59, 2) = "SD%"

'boucle for qui permettra de parcourir les colonne et donc de faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

    For j = 3 To 9

        moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
        moytest = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDtest = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) + 1

        'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
        Do Until SDtest - SD = 0

        'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
            For i = 24 To 53

                If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty

            Next

            'on stocke l'ancienne moyenne et l'ancien SD dans les variables XXXtest pour faire ensuite le test du while
            moytest = moy
            SDtest = SD
            moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
            SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)

        Loop

        'on calcule les moy et SD finaux et on les affiche dans tel ou tel colonnes/lignes correspondante
        moyfinal = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
        SDfinal = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) * 2
        .Cells(57, j).Value = moyfinal
        .Cells(58, j).Value = SDfinal
        .Cells(59, j).Value = (SDfinal / moyfinal) * 100

    Next

End With
End Sub
Le 29/06/2021 à 14:50

bonjour,

essaie ceci (non testé)

Sub precision_interne234U()

    Dim j As Integer
    Dim i As Integer
    Dim moy As Double
    Dim SD As Double
    Dim moytest As Double
    Dim SDtest As Double
    Dim wb As Object
    For Each wb In Workbooks
        With wb.Sheets("017-IRMM100")

            'on nomme les cellules de debut ou l'on mettra les différents résultat

            .Cells(57, 2) = "moyenne"
            .Cells(58, 2) = "StandDev(x2)"
            .Cells(59, 2) = "SD%"

            'boucle for qui permettra de parcourir les colonne et donc de faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

            For j = 3 To 9

                moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
                moytest = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                SDtest = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) + 1

                'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
                Do Until SDtest - SD = 0

                    'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
                    For i = 24 To 53

                        If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                        If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty

                    Next

                    'on stocke l'ancienne moyenne et l'ancien SD dans les variables XXXtest pour faire ensuite le test du while
                    moytest = moy
                    SDtest = SD
                    moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                    SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)

                Loop

                'on calcule les moy et SD finaux et on les affiche dans tel ou tel colonnes/lignes correspondante
                moyfinal = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                SDfinal = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) * 2
                .Cells(57, j).Value = moyfinal
                .Cells(58, j).Value = SDfinal
                .Cells(59, j).Value = (SDfinal / moyfinal) * 100

            Next

        End With
    Next
End Sub
Le 29/06/2021 à 15:39

Bonjour,

Premièrement merci.

Si je comprends bien la boucle

 For Each wb In Workbooks

permet de parcourir tous les classeurs ouvert.

Mais malheureusement j'ai toujours un pb. Les feuilles ne s'appelle pas toute "017-IRMM100" et j'aimerais savoir comment faire pour que ma macro s'applique à toute les feuilles des classeurs.

Je vous remercie car vous m'avez déjà bien aidé en me permettant de parcourir tous les classeur il ne me manque plus qu'un dernier coup de poucemerci.

Bonne journée,

Le 29/06/2021 à 16:09
Sub precision_interne234U()

    Dim j As Integer
    Dim i As Integer
    Dim moy As Double
    Dim SD As Double
    Dim moytest As Double
    Dim SDtest As Double
    Dim wb As Object, ws As Object
    For Each wb In Workbooks
        For Each ws In wb.Worksheets
            With ws

                'on nomme les cellules de debut ou l'on mettra les différents résultat

                .Cells(57, 2) = "moyenne"
                .Cells(58, 2) = "StandDev(x2)"
                .Cells(59, 2) = "SD%"

                'boucle for qui permettra de parcourir les colonne et donc de faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

                For j = 3 To 9

                    moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                    SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)
                    moytest = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                    SDtest = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) + 1

                    'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
                    Do Until SDtest - SD = 0

                        'on parcours les lignes 24 à 53 où les 30 mesures d'un isotope sont avec la boucle for
                        For i = 24 To 53

                            If .Cells(i, j) >= 2 * SD + moy Then .Cells(i, j) = Empty
                            If .Cells(i, j) <= 2 * SD - moy Then .Cells(i, j) = Empty

                        Next

                        'on stocke l'ancienne moyenne et l'ancien SD dans les variables XXXtest pour faire ensuite le test du while
                        moytest = moy
                        SDtest = SD
                        moy = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                        SD = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value)

                    Loop

                    'on calcule les moy et SD finaux et on les affiche dans tel ou tel colonnes/lignes correspondante
                    moyfinal = Application.Average(.Range(.Cells(24, j), .Cells(53, j)).Value)
                    SDfinal = Application.StDev(.Range(.Cells(24, j), .Cells(53, j)).Value) * 2
                    .Cells(57, j).Value = moyfinal
                    .Cells(58, j).Value = SDfinal
                    .Cells(59, j).Value = (SDfinal / moyfinal) * 100

                Next

            End With
        Next ws
    Next wb
End Sub

re-bonjour,

une nouvelle proposition (toujours non testée). qui applique la macro sur toutes les feuilles de tous les classeurs ouverts.

Rechercher des sujets similaires à "appliquer script tous classeur ouvert"