XL 2019 erreur 1004

Kapioss

XLDnaute Nouveau
Bonjour,
Je suis chimiste analyticien et dans le cadre de mes recherches j'essaye de me programmer une petite macro sur VBA afin de faciliter le traitement de mes données.
J'essaye ici simplement d'exclure les valeurs aberrantes lors de mes analyses.
Aujourd'hui j'ouvre mon fichier excel avec mes données et en traçant celle-ci j'identifie les valeurs aberrantes et je les retire "à la main". Ensuite je calcule ma moyenne et mon écart type et encore une fois je retire les valeurs qui sortent de + ou - 2x mon écart type "à la main".

Comme vous pouvez le supposer cela est très chronophage surtout quand dans une séquence d'analyse isotopique j'ai parfois 200 à 300 analyses elles-même composés de 30 mesures de plusieurs isotopes différents et ainsi pour vérifier la précision interne de mon appareil il me faut ouvrir les 200/300 fichiers de 30 mesures et faire cette exclusion à la main sur chaque isotope....

j'ai donc voulu essayer sur la colonne C qui est mon isotope 234U et dont les valeurs sont sur les ligne 24 à 53 et voici mon code VBA

Sub precision_interne234U()

Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moy2 As Double
Dim SD2 As Double

moy = WorksheetFunction.Average(Range("C24:C53"))
SD = WorksheetFunction.StDev(Range("C24:C53"))

For i = 24 To 53

If Cells(i, 3) >= moy + 2 * SD Then Cells(i, 3) = ""
If Cells(i, 3) <= moy + 2 * SD Then Cells(i, 3) = ""

Next
'recalcule des moy et ecart type sans les valeurs abérrantes

moy2 = WorksheetFunction.Average(Range("C24:C53"))
SD2 = WorksheetFunction.StDev(Range("C24:C53"))

End Sub

Mon problème est que lorsque je fait F5, j'ai une erreur d’exécution 1004 et je n'arrive pas à résoudre ce problème en fouillant sur le forum ni même a très bien comprendre ce qu'est cette fameuse erreur.

En vous remerciant par avance
 

Kapioss

XLDnaute Nouveau
Franchement vous me perdez. J'ai essayé d'implémenter votre procédure mais je n'y arrive pas et les fonction que vous utilisez sont trop compliqué pour moi.

J'aimerais simplement créer un petit outils en VBA qui me permette d'enlever les valeurs aberrante, qu'il soit optimal ou pas m'importe peu.

La seul chose que j'ai réussi à faire est d'implémenter votre test qui permet en une seul condition d'exclure les valeurs sortants de 2*SD. Mais j'ai toujours la même erreur 1004
 

Kapioss

XLDnaute Nouveau
Serait-il possible de repartir de ce code-ci svp ?
Je vous joint un fichier d'analyse
VB:
Sub precision_interne234U()

Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moy2 As Double
Dim SD2 As Double
With Sheets("005-IRMM100")

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

    Range(.Cells(2, 58)).Name = "moyenne"
    Range(.Cells(2, 59)).Name = "StandDev(x2)"
    Range(.Cells(2, 60)).Name = "%SD"
'boucle for qui permettra des faire les isotopes 234U à 238U qui sont des colonnes 3 à 6, on parcours donc les colonnes 3 à 6

    For j = 3 To 6
    
        moy = Application.Average(.Range(.Cells(j, 24), .Cells(j, 53)).Value)
        SD = Application.StDev(.Range(.Cells(j, 24), .Cells(j, 53)).Value)
        moytest = Application.Average(.Range(.Cells(j, 24), .Cells(j, 53)).Value)
        SDtest = Application.StDev(.Range(.Cells(j, 24), .Cells(j, 53)).Value)
        
        'paramètre de test arbitraire on fera des test pour voir ce qui est le plus adequat 50%, 75% 80% etc
        Do While SD / SDtest >= 0.75
        
        'on parcours les lignes 24 à 53 ou les 30 mesures sont avec la boucle for
            For i = 24 To 53

                If Abs(.Cells(i, j) - moy) >= 2 * SD 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(j, 24), .Cells(j, 53)).Value)
            SD = Application.StDev(.Range(.Cells(j, 24), .Cells(j, 53)).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(j, 24), .Cells(j, 53)).Value)
        SDfinal = Application.StDev(.Range(.Cells(j, 24), .Cells(j, 53)).Value)
        Range(.Cells(j, 58)).Value = moyfinal
        Range(.Cells(j, 59)).Value = SDfinal * 2
        Range(.Cells(j, 60)).Value = (moyfinal / (2 * SDfinal)) * 100
      
        
    Next
'recalcule des moy et ecart type sans les valeurs abérrantes



End With
End Sub
 

Pièces jointes

  • 005-IRMM100.xlsm
    22.8 KB · Affichages: 7

Kapioss

XLDnaute Nouveau
Non. si vous ne voulez pas faire l'effort de comprendre je ne vais pas repartir de quelque chose de moins bon, et ne permettant pas de paramétrer la plage à traiter.
C'est vraiment dommage de penser ce genre de chose. J'ai perdu plus d'une journée de travail a essayer de comprendre votre code et de l'implémenter dans le miens.
Je n'ai aucune formation en programmation en VBA et mes connaissances ce limite a mes recherches sur ces 5 derniers jours.
Je ne comprends même pas que vous ne vouliez pas repartir de quelque chose de moins bon mais que je peux avec mes maigres connaissance comprendre, le but d'un forum n'est-il pas de s'aider.

Bonne journée et merci quand même
 

Kapioss

XLDnaute Nouveau
Bonjour,

Merci pour votre aide j'ai finalement pas mal avancé et il y avait plusieurs petites fautes de syntaxe.
Ma Macro tourne maintenant même si elle n'est pas parfaite et optimal ;).
Cependant j'ai un petit problème : j'aimerais pouvoir la faire tourner sur TOUS les classeurs ouverts au moment ou je fais F5.

En effet dans mon code j'appel avec with sheets ("XXXX") le classeur à traiter cependant j'aimerais que lorsque j'appuie sur F5 ma macro (enregistré dans mon PERSONNAL) s'applique sur TOUS les classeurs ouvert.

Pourriez vous m'aidez ?

Je vous joint mon script
VB:
Sub precision_interne234U()

Dim j As Integer
Dim i As Integer
Dim moy As Double
Dim SD As Double
Dim moy2 As Double
Dim SD2 As Double
Dim test As Double

With Sheets("XXXX")

'on nomme les cellules de début 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
 

Discussions similaires

Réponses
2
Affichages
1 K
Réponses
0
Affichages
83