Imbriquer 3 boucles for

[mroma]

Bjr,

Je n'arrive pas à imbriquer mes 3 boucles for suivante :

With ActiveSheet() ' With ThisWorkbook.Sheets("Document")
    ' Colonne H = CAT Garder les doc [D]
    For i = .Range("H" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("H" & i).Value <> "[D]" Then
        .Rows(i).Delete
      End If
    Next i
  End With
                        
  With ActiveSheet() ' With ThisWorkbook.Sheets("Document")
  ' Barrer la cellule si absence de "ACTUAL DATE" dans colonne R
    For k = .Range("R" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("R" & k).Value = "" Then
        .Range("R" & k).Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Range("R" & k).Borders(xlDiagonalDown).LineStyle = xlContinuous
      End If
    Next k
  End With

  With ActiveSheet() ' With ThisWorkbook.Sheets("Document")
  ' Barrer la cellule si absence de "CLIENT REFERENCE" dans colonne F
    For j = .Range("F" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("F" & j).Value = "" Then
        .Range("F" & j).Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Range("F" & j).Borders(xlDiagonalDown).LineStyle = xlContinuous
      End If
    Next j
  End With

Une idée ?

Merci ! 😉

 

[JBARBE]

Re : Imbriquer 3 boucles for

Bonjour à tous,

Peut-être ceci en simplifiant la macro :

With ActiveSheet("Document") ' With ThisWorkbook.Sheets("Document")
    ' Colonne H = CAT Garder les doc [D]
    For i = .Range("H" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("H" & i).Value <> "[D]" Then
        .Rows(i).Delete
      End If
     Next i
                       
  ' Barrer la cellule si absence de "ACTUAL DATE" dans colonne R
    For k = .Range("R" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("R" & k).Value <> "ACTUAL DATE" Then
        .Range("R" & k).Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Range("R" & k).Borders(xlDiagonalDown).LineStyle = xlContinuous
      End If
    Next k

  ' Barrer la cellule si absence de "CLIENT REFERENCE" dans colonne F
    For j = .Range("F" & .Rows.Count).End(xlUp).Row To 2 Step -1
      If .Range("F" & j).Value <> "CLIENT REFERENCE" Then
        .Range("F" & j).Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Range("F" & j).Borders(xlDiagonalDown).LineStyle = xlContinuous
      End If
    Next j
  End With

bonne journée à tous

 

[Dranreb]

Re : Imbriquer 3 boucles for

Bonjour.

À tout hasard essayez ça sur votre classeur non joint: si jamais ça marche, ça pourrait être beaucoup plus rapide :

Sub test()
With ActiveSheet
   CelColOù(.[A2], "H", "<>", "[D]").EntireRow.Delete
   With CelColOù(.[R2], "R", "=", "")
      .Borders(xlDiagonalUp).LineStyle = xlContinuous
      .Borders(xlDiagonalDown).LineStyle = xlContinuous: End With
   With CelColOù(.[F2], "F", "=", "")
      .Borders(xlDiagonalUp).LineStyle = xlContinuous
      .Borders(xlDiagonalDown).LineStyle = xlContinuous: End With
   End With
End Sub
Function CelColOù(ByVal CelDéb As Range, ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Dim Lignes As Range, ColTrv As Range, Z As String
With CelDéb.Worksheet.UsedRange
   Set CelColOù = CelDéb.Resize(.Rows.Count + .Row - CelDéb.Row)
   Set ColTrv = Intersect(.Columns(.Columns.Count + 1), CelColOù.EntireRow): End With
If Not IsNumeric(ColQuoi) Then ColQuoi = ColTrv.EntireRow.Columns(ColQuoi).Column
If IsNumeric(Valeur) Then Valeur = Trim$(Str$(Valeur)) Else Valeur = """" & Valeur & """"
ColTrv.FormulaR1C1 = "=1/(RC" & ColQuoi & Opé & Valeur & ")"
On Error Resume Next
Set CelColOù = Intersect(ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow, CelColOù)
ColTrv.EntireColumn.Delete
End Function

 

[mroma]

Re : Imbriquer 3 boucles for

Merci pour les 2 réponses,
ça fonctionne très bien Dranreb 😀

Amicalement