Identifier premiere/derniere ligne bloc selon fonction match
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
Merci !
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
Super,
Ça semble bien fonctionner!
Merci de ton aide