Discussion :

[bugstar]

Bonjour,

J'en suis toujours sur le principe du modèle que j'évoque sur ce ticket :
https://www.developpez.net/forums/d1...via-vba-excel/

Cette fois, je propose une autre version. Plutôt que de faire intervenir l'utilisateur via des Intpubox pour sélectionner les blancs etc... , je souhaite faire le traitement des données à partir d'un plan de plaque. Le gain de temps est discutable aussi je souhaite en laisser le choix aux collègues.
Sur la plan de plaque (1er tableau) l'utilisateur défini le type de contenu du puits (cellule) via un menu déroulant (S1 & S2 pour des standards, E1 & E2 pour les échantillons -1 & 2 pour les duplicate - , B pour la blancs).
Dans le second tableau, le collègue complète les valeurs et se mettent d'une certaines couleurs en fonction du plan de plaque via des MFC.
De là je calcul la moyenne et génère un 3ème tableau avec les valeurs brutes moins cette moyenne. Voyant le côté délicat à traiter les MFC, ce troisième tableau est colorisé via la macro suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule As Range
If Not Application.Intersect(Target, Range("B2:M9")) Is Nothing Then
    For Each Cellule In Target
        If Cellule.Value = "S1" Then
            Cellule.Offset(26, 0).Interior.Color = 15773696
        ElseIf Cellule.Value = "S2" Then
            Cellule.Offset(26, 0).Interior.Color = 15773400
                    ElseIf Cellule.Value = "B" Then
            Cellule.Offset(26, 0).Interior.Color = 255
        ElseIf Cellule.Value = "E1" Then
            Cellule.Offset(26, 0).Interior.Color = 255160
        ElseIf Cellule.Value = "E2" Then
            Cellule.Offset(26, 0).Interior.Color = 255100
        Else
            Cellule.Offset(26, 0).Interior.Pattern = xlNone
        End If
    Next Cellule
End If
 
End Sub

Maintenant je souhaite mettre en forme ces données afin de pouvoir lancer l'analyse sur Prism.
L'idée que je ma fais c'est de tester via des boucles l'ensemble du 3ème tableau (B28:M35) et copier (d'abord les S1, puis les S2, puis les E1 et les E2) les valeurs en fonction de la couleur des cellules (sauf les blancs étant exclus) définie dans la macro ci-dessus.
Autre subtilité, le nombre des valeurs sont variables. Si les standards 1 peuvent être commencés à être collés en B40 par exemple (et donc les standards 2 en C40), la copie des E1 et E2 doivent se copier à la suite de S1 et S2.

J'ai et je potasse les posts suivants :
https://www.developpez.net/forums/d1...leur-cellules/
https://www.developpez.net/forums/d1...ule-d-feuille/

que je tente d'adapter... et assez mal pour le moment j'en conviens.
Bonne journée

Bug*

[sogedic]

Un point de départ

1. enregister une couleur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Option Explicit
Dim cdPattern As Variant, cdPatternColorIndex  As Variant, cdthemecolor  As Variant
Dim cdColor As Variant, cdTintAndShade As Variant, cdPatternTintAndShade  As Variant
...
With cellTest1
        cdPattern = .Pattern: cdPatternColorIndex = .PatternColorIndex: cdColor = .Color
        cdTintAndShade = .TintAndShade: cdPatternTintAndShade = .PatternTintAndShade
End With

2.tester si la couleur corresponf

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
for each cell in rangeaTester
 if (. Pattern = cdPattern) and _
            … and _
    (.PatternTintAndShade=cdPatternTintAndShade) then
 
   Traitement_Cellules_de_Couleur1
 end if
next each

A développer, adapter ...

[bugstar]

Bonjour Sogedic,

Merci pour ces infos.
Cependant, je galère tout autant aussi pour avancer je suis passé par des filtres et des formules conditionnelles.
Cela fonctionne mais ce n'est pas satisfaisant, cela fait plutôt bidouille ;-).
Bref, il faut que je creuse davantage ce que tu m'as donné.
Encore merci.

Bug*

[Bob78280]

Pourquoi ne pas faire un filtre sur la couleur et de copier le résultat?
Quelque chose du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
' 1ère copie
Range("$B$2:$M$9").AutoFilter Field:=1, Criteria1:=RGB(0, 176, 240), Operator:=xlFilterCellColor
Range("B2:B10").Select
Selection.Copy
Range("B40").Select
ActiveSheet.Paste
 
' pour copier à la suite
iRow = Range("B40").End(xlDown).row+1
 
Range("$B$2:$M$9").AutoFilter Field:=1, Criteria1:=RGB(216, 174, 240), Operator:=xlFilterCellColor
Range("B2:B10").Select
Selection.Copy
Range("B" & iRow).Select
ActiveSheet.Paste