Copier-coller et calculs de valeur selon conditions

Bonjour à toutes et tous,

Je reviens à la charge pour améliorer un autre process qui est encore une fois trop compliqué à coder pour moi. Encore merci pour l'apport d'aide précédent!

Ci-joint le fichier excel que je vais détailler.

1/ Colonne A à M se trouvent les valeurs sources que j'entre moi-même.

2/ Colonnes P à CU se trouvent 6 tableaux dit "de calculs", qui piochent dans les valeurs sources pour faire un calcul simple. La seule différence dans ces 6 tableaux résident dans l'une des variable, le "volume" en rouge et en gras au dessus de chaque tableau. Nous avons donc 6 volumes de 20 à 200 pour 6 tableaux.

Voici ce que je réalise manuellement:
- Je choisis une valeur issue de l'un des 6 tableaux de calculs. Elle doit être supérieure ou égale à 3, et inférieur ou égale à 13. Si plusieurs valeurs correspondent à ce critère, je choisis préférentiellement celle des tableaux selon l'ordre suivant: 55, 35, 20, 100, 150, 200.
- Une fois choisie, je copie colle cette valeur dans le tableau "ADN" (colonne CW à DI).
- Enfin, je réalise un calcul sur le tableau "EAU" se trouvant en dessous du tableau ADN. Je prends l'exemple de la colonne "A1" (CX6). J'ai choisi la valeur 3.79 en provenance du tableau de calcul associé au volume 55. Je vais donc, dans la case "A1" (CX16) du tableau "EAU" faire la différence entre le volume 55 et 3.79. Evidemment, la volume change selon d'où vient la valeur choisie initialement.

Autre détail:

Lorsqu'aucunes valeurs ne correspond aux critères dans les 6 tableaux de calculs, on peut laisser les cases des tableaux de destination ADN et EAU vides. Le correctif se fera manuellement. :)

En espérant avoir été assez clair, je vous remercie grandement pour toute l'aide apportée. :)
Je n'oublierais pas de partager une vidéo du robot que ces fichiers sont censés alimenter!

Romain.

Salut Romain,

mais dans quelles conditions travaillez-vous au CNRS ? Pas d'informaticiens pour réaliser cela pour vous ? En 2020 ?

Pour tout avoir sur mon écran et comprendre ton truc, j'ai un peu changé les positions de tes tableaux et créé 2 nouveaux pour que tu puisses comparer les résultats.
- Un double-clic sur la feuille démarre le calcul ;
- un changement de valeur dans ton tableau-source efface mes tableaux-résultats ;
- les valeurs colorées sont les cas où la macro n'a pas trouvé de valeur correspondante aux critères.

Il te manquait une ligne dans ton tableau EAU : la "D". Normal ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iOK%, iCalc%
'
Cancel = True
Application.EnableEvents = False
Application.ScreenUpdating = False
'
Call Nettoyage
'
For iRow = 0 To 7
    For iCol = 0 To 11
        iOK = 0
        For x = 1 To 2
            For y = 2 To 30 Step 14
                If Round(Cells(IIf(x = 1, 21, 35) + iRow, y + iCol), 2) >= 3 And _
                    Round(Cells(IIf(x = 1, 21, 35) + iRow, y + iCol), 2) <= 13 Then
                        iOK = 1
                        Cells(45 + iRow, 16 + iCol) = Round(Cells(IIf(x = 1, 21, 35) + iRow, y + iCol), 2)
                        iCalc = CInt(Cells(4 + (x * 14), y + 3))
                        Cells(45 + iRow, 30 + iCol) = Round(iCalc - Cells(45 + iRow, 16 + iCol), 2)
                End If
                If iOK = 1 Then Exit For
            Next
            If iOK = 1 Then Exit For
        Next
        If iOK = 0 Then
            Cells(45 + iRow, 16 + iCol) = Format(3, "##0,00")
            Cells(45 + iRow, 16 + iCol).Interior.Color = RGB(190, 190, 190)
            Cells(45 + iRow, 30 + iCol).Interior.Color = RGB(190, 190, 190)
        End If
    Next
Next
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

A+

Salut Romain,

petit add-on à copier-coller à la suite du code du fichier pour faciliter l'encodage des cellules 'ADN' grisées n'ayant reçu qu'une valeur 3.00 par défaut.
- un clic sur une de ces cellules 'ADN' inscrit son adresse en [N45] ;
- modifier éventuellement sa valeur SANS la valider;
- clic sur une valeur 'VOLUME', en rouge, dans un des 6 tableaux de calcul;
- le résultat de la soustraction s'inscrit dans la cellule-miroir en 'EAU'.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Target.Font.Color = RGB(255, 0, 0) And [N45] <> "" Then _
    Range([N45]).Offset(0, 14) = Round(Target - Range([N45]).Value, 2): _
    Union(Range([N45]), Range([N45]).Offset(0, 14)).Interior.Color = RGB(190, 210, 150)
'
[N45] = ""
'
If Not Intersect(Target, Range("P45:AA52")) Is Nothing Then _
    If Target.Interior.Color <> RGB(255, 255, 255) Then [N45] = Target.Address
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

A+

Salut Curulis,

Et du zèle avec ça. :)

Merci beaucoup pour ton travail, cela correspond tout à fait à mes besoins, je n'ai pas repéré de problèmes. Voilà qui va grandement soulager mon équipe, qui, en effet, ne dispose pas d'un informaticien disponible pour nous aider... Alors je me débrouille autrement ! :)

Je te souhaite une excellente continuation,
Romain.