[VBA] Cellule Range ...

Résolu/Fermé
Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 - 21 nov. 2011 à 12:05
Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 - 21 nov. 2011 à 16:55
Bonjour,

Je fais face à une problématique concernant une macro VBA.
Ce qu'elle fait :
-Copie les données d'un tableau croisé dynamique et colle valeur et Mise en forme de la source.
-Ensuite permet à l'utilisateur de selectionner avec la souris une plage de cellule.

Je souhiate récuperer cette selection et faire des traitements par ligne (trouver mini et maxi pour chaque ligne contenu dans la selection)

Mon code est le suivant :
Sub CopierValeur()

    Cells.Select
    Selection.Copy
    Sheets("AnalysePrix").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    SelectionPlageAvecSouris
End Sub
 ______________________________________________________   
Function SelectionPlageAvecSouris()
      
    Dim Plage As Range
    Dim Coord As String
    Dim ColoPrem, ColoDer As String

    
On Error Resume Next
    Set Plage = Application.InputBox("Sélectionnez une cellule ou une plage :", Type:=8)
    Coord = Plage.Address(ReferenceStyle:=xlA1, RowAbsolute:=False, ColumnAbsolute:=False)
    ColoDern = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    
    
    On Error GoTo 0
    If Plage Is Nothing Then MsgBox "Sélection annulée"
    
    boucle Plage
      'ColorieValeur Coord
End Function
 ______________________________________________________   
Function boucle(Plage)
    For Each row In Plage.Rows
        MsgBox "test"
        'x = Application.WorksheetFunction.Min(.Range(.Cells(deb, 1), .Cells(fin, 1)))
        
    Next
End Function


J'arrive bien à parcourir mes lignes une a une avec la fonction boucle mais incapable de borner les cell(deb) et cell(fin) pour exploiter la fonction min .

Merci à ceux qui auront la gentillesse de m'eclairer.




3 réponses

Bonjour

Si j'ai bien compris:

Function boucle(Plage)
For Each Rangée In Plage.Rows
    MsgBox Application.WorksheetFunction.Min(Range(Rangée.Address))        
Next
End Function

(J'ai changé row en Rangée, car row est un mot réservé vba)

Bonne suite
1
Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 26
21 nov. 2011 à 14:43
Oui un grand merci à toi (ca fait un jour et demi que je cherche.).
Juste une question comment faire pour 'colorier' la cellule qui contient la valeur min et max j'avais pensé à ca :

Function boucle(Plage)
    For Each Rangée In Plage.Rows
       MinVal = Application.WorksheetFunction.Min(Range(Rangée.Address))
       MaxVal =Application.WorksheetFunction.Max(Range(Rangée.Address))
      ' If cell.Value = MinVal Then cell.Interior.Color = vbGreen
      ' If cell.Value = MaxVal Then cell.Interior.Color = vbRed
    Next
End Function

A ton avis il est préférable de faire une nouvelle boucle qui test la valeur (il peut y avoir deux cellules qui contiennent min ou max si les valeurs sont identiques) ou y a t-il mieux.
Merci encore pour ta réponse et ton aide.
0
re
Application.WorksheetFunction.Min ne permet pas de déterminer quelle cellule contient le min (ou le max) on ne peut donc pas modifier la couleur( et encore moins si plusieurs cellules contiennent le min).

Une proposition qui n'est sans doute pas la meilleurs, mais qui fonctionne
For Each Rangée In Plage.Rows
    MinVal = Application.WorksheetFunction.Min(Range(Rangée.Address))
    MaxVal = Application.WorksheetFunction.Max(Range(Rangée.Address))
    For Each cel In Rangée.Cells
        If Val(cel.Value) = MinVal Then
            cel.Interior.Color = vbGreen
        End If
        If Val(cel.Value) = MaxVal Then
            cel.Interior.Color = vbRed
        End If
    Next
Next
Bonne suite
0
Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 26
21 nov. 2011 à 16:55
Merci beaucoup c'est que j'ai finis par faire je regarde pour optimiser le code car si le tab fait plusieurs millier de ligne ca va chauffer .
Je vais m'orienter du coté de la macro automatique pour alleger le code:

    Range("C5:AM5").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=C5=MIN($C$5:$AM$5)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With


en tout cas merci pour ta dispo et tes réponses.
0