Identifier premiere/derniere ligne bloc selon fonction match

Le 06/03/2018 à 02:15

Bonjour,

Je cherche à adapter ma macro pour qu'elle change la couleur d'une plage lorsque celui-ci contient "ST-"*. (voir valeurs colonne H)

J'ai mis en rouge ce que je ne suis pas certain et je joint un fichier pour aider, car c'est un peu difficile à expliquer.

Sub operation_ST()

'Si un opération contient ST peu importe la ligne du bloc, mettre le bloc rouge

Dim Arr_Sheets(6) As String

Dim Ob_Sheet As Worksheet

Dim rouge&, noir&, ncouleur, txtCouleur, tcouleur

Dim ln&, k&, derln&

rouge = RGB(255, 204, 255)

noir = RGB(0, 0, 0)

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.DisplayStatusBar = False

Arr_Sheets(0) = "PEM"

Arr_Sheets(1) = "SPOT"

Arr_Sheets(2) = "TIME SAVER"

Arr_Sheets(3) = "SOUDURE"

Arr_Sheets(4) = "FINITION"

Arr_Sheets(5) = "ASSEMBLAGE"

Arr_Sheets(6) = "PLIAGE"

For s = 0 To 6

Val_sh = Arr_Sheets(s)

Set Ob_Sheet = ThisWorkbook.Worksheets(Val_sh)

derniere_ligne = Ob_Sheet.Cells(Ob_Sheet.Rows.Count, 4).End(xlUp).Row

'Valide si contient au moins un "ST" dans la feuille si non passe à la suivante

x = Application.Match("ST" & "*", Range("H:H"), 0)

If IsError(x) Then

Next s

Else

'Si oui mettre toute le bloc rouge. de D##:AA## (celui qui contient le ST)

For i = derniere_ligne To 2 Step -1

val_a = Ob_Sheet.Cells(i, 2).Value

val_f = Ob_Sheet.Cells(i + 5, 4).Value

If val_a <> "" And val_f = "" Then

'Ob_Sheet.Rows(i).EntireRow.Delete

End If

Next i

End If

Next s

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.DisplayStatusBar = True

End Sub

7classeur1.xlsm (28.75 Ko)

Merci !

Le 06/03/2018 à 07:11

Bonjour,

Une piste avec Like :

Sub operation_ST()

    'Si un opération contient ST peu importe la ligne du bloc, mettre le bloc rouge
    Dim Plage As Range
    Dim PlageCouleur As Range
    Dim Arr_Sheets(6) As String
    Dim Ob_Sheet As Worksheet
    Dim rouge&, noir&, ncouleur, txtCouleur, tcouleur
    Dim ln&, k&, derln&

    rouge = RGB(255, 204, 255)
    noir = RGB(0, 0, 0)

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False

    Arr_Sheets(0) = "PEM"
    Arr_Sheets(1) = "SPOT"
    Arr_Sheets(2) = "TIME SAVER"
    Arr_Sheets(3) = "SOUDURE"
    Arr_Sheets(4) = "FINITION"
    Arr_Sheets(5) = "ASSEMBLAGE"
    Arr_Sheets(6) = "PLIAGE"

    For s = 0 To 6

        Set Ob_Sheet = ThisWorkbook.Worksheets(Arr_Sheets(s))

        With Ob_Sheet: Set Plage = .Range(.Cells(1, 8), .Cells(.Rows.Count, 8).End(xlUp)): End With

        For i = 1 To Plage.Count

            If Plage(i).Value Like "ST*" Then

                With Ob_Sheet

                    Set PlageCouleur = .Range(.Cells(i, 8).End(xlUp), .Cells(i, 8).End(xlDown))
                   .Range(.Cells(PlageCouleur(1).Row, 4), .Cells(PlageCouleur(1).Row + PlageCouleur.Count - 1, 24)).Interior.ColorIndex = 3

                End With
            End If

        Next i

        derniere_ligne = Ob_Sheet.Cells(Ob_Sheet.Rows.Count, 4).End(xlUp).Row

    Next s

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True

End Sub
Le 06/03/2018 à 13:34

Super,

Ça semble bien fonctionner!

Merci de ton aide

Rechercher des sujets similaires à "identifier premiere derniere ligne bloc fonction match"