[RESOLU] Probléme pour identifier 1ére cellule non vide

[loulou14]

Bonjour à tous

Dans un tableau je herche à identifier (couleur jaune), la première cellule non vide, pour chaque ligne non vide, sur un range de la colonne B à la dernière colonne non vide vers la droite

J'utilise un code qui me renvoie des incohérences.
Peut être que je n'emploie pas la bonne méthode

En PJ un fichier exemple, les incohérences sont entourées en rouge

Code utilisé

Sub Macro4()
'
' Macro4 Macro

Dim i As Long, DerniereLigne As Long
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
    For i = 2 To DerniereLigne
    Sheets("Feuil1").Range("B" & i).End(xlToRight).Interior.ColorIndex = 6
    Next i
End Sub

Merci d'avance pour votre aide

 

[phlaurent55]

Bonjour loulou,

avec ce code:

Sub Macro4()
Dim i As Long, DerniereLigne As Long
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
    For i = 2 To DerniereLigne
    Sheets("Feuil1").Range("IV" & i).End(xlToLeft).Interior.ColorIndex = 6
    Next i
End Sub

la modif concerne cette ligne:

Sheets("Feuil1").Range("IV" & i).End(xlToLeft).Interior.ColorIndex = 6

à+
Philippe

 

[loulou14]

Merci pour ta réponse

Malheureusement, le code ne renvoit pas la sélection souhaitée , c'est à dire la première cellule non vide en partant de la colonne C jusqu'à dernière colonne. Répéter l'opération pour chaque ligne.

 

[PMO2]

Bonjour,

Peut être comme cela :

Sub Macro4()
Dim i As Long, DerniereLigne As Long
Dim NbCol As Long
Dim j As Long
Dim C As Range
'---
NbCol = [a1].CurrentRegion.Columns.Count
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
    For i = 2 To DerniereLigne
      For j& = 3 To NbCol
        Set C = Sheets("Feuil1").Cells(i, j)
        If C <> "" Then
          C.Interior.ColorIndex = 6
          Exit For
        End If
      Next j
    Next i
End Sub

 

[phlaurent55]

Re,

Re,

ou peut-être comme ceci,

Sub Macro4()
Dim i As Long, DerniereLigne As Long
Dim NbCol As Long
Dim j As Long
Dim C As Range
NbCol = [a1].CurrentRegion.Columns.Count
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
    For i = 2 To DerniereLigne
      For j = 3 To NbCol
        Set C = Sheets("Feuil1").Cells(i, j)
        If C <> "" And C.Offset(0, 1) = "" Then
          C.Interior.ColorIndex = 6
          Exit For
        End If
      Next j
    Next i
End Sub

à+
Philippe

 

[loulou14]

Formidable !
C'est le scénario imaginé sans avoir la compétence pour écrire le code.

Merci à tous

Problème résolu

 

[job75]

Bonjour loulou14, Philippe, Patrick,

On peut se passer de macro avec cette MFC sur C2:K18 :

=COLONNE()=COLONNE($C2)+SI($C2="";EQUIV(1;($C2:$J2="")*($D2:$K2<>"");0))

La formule est matricielle mais dans une MFC pas besoin d'une validation spéciale.

Fichier .xlsx joint.

A+

 

[Si...]

Bonjour

Un autre exemple avec macros pour colorer ou pas.

 

[job75]

Bonsoir Si...

Un autre exemple sans macros pour colorer ou pas.

 

[Si...]

Re

Hello Job, bien vu (je suis incapable de pondre des formules comme celle- là 😕).

 

[job75]

Re,

Si les valeurs du tableau sont importées avec un nombre de lignes variables, on peut appliquer la MFC sur les colonnes C:K entières en adaptant la formule (en C1) :

=($M$1="Avec")*(LIGNE()>1)*COLONNE()=COLONNE($C1)+SI($C1="";EQUIV(1;($C1:$J1="")*($D1:$K1<>"");0))

Il ne faut pas insérer de lignes au-dessus de la ligne 1.

Fichier (3).

A+

 

[job75]

Bonjour le fil,

Pour tester j'ai copié le tableau sur 51 000 lignes.

Durées d'exécution chez moi sur Win 10 - Excel 2013 :

- macro de PMO2 post #4 => 3,7 secondes

- macro de Si... post #8 => 8,5 secondes

- MFC (recalcul) du post #11 => 25 millionièmes de seconde (25 µs), c'est instantané.

Remarques :

- pour tester la MFC j'ai rendu la formule volatile avec ENT(ALEA()) et fait une boucle sur Calculate

- l'ajout de Application.ScreenUpdating =False sur les macros ne fait pratiquement rien gagner

- la macro de Philippe du post #5 ne donne pas les bons résultats.

Bonne journée.

 

[PMO2]

Salut job75,

Pourrais-tu tester la macro ci-dessous et voir combien de temps elle met ?
J'ai remplacé la colorisation cellule par cellule par une colorisation unique de tout le Range concerné qui se fait en une seule fois.

Sub Macro4()
Dim i As Long, DerniereLigne As Long
Dim NbCol As Long
Dim j As Long
Dim C As Range
Dim R As Range
'---
NbCol = [a1].CurrentRegion.Columns.Count
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
For i = 2 To DerniereLigne
  For j = 3 To NbCol
    Set C = Sheets("Feuil1").Cells(i, j)
    If C <> "" Then
   
      If R Is Nothing Then
        Set R = C
      Else
        Set R = Application.Union(R, C)
      End If
     
      Exit For
    End If
  Next j
Next i
   
If Not R Is Nothing Then R.Interior.ColorIndex = 6  'on colorise d'un seul coup
End Sub

En théorie on devrait obtenir un gain de temps mais j'aimerais savoir lequel.
Merci et à plus.

 

[job75]

Bonjour Patrick,

Je savais ce qui allait se passer avec cette macro mais j'ai quand même testé.

Et j'ai quitté Excel au bout de 5 minutes par le Gestionnaire des tâches.

Il faut savoir qu'il y a de gros problèmes avec Union s'il y a beaucoup de cellules disjointes !!!

Pour y remédier il faut décharger dans la feuille périodiquement, disons toutes les 100 ou 200 cellules.

A+

 

[job75]

Re,

Avec cette macro le pas de décharge optimal est de 100 :

Sub Macro4()
Dim t As Double
Dim pas As Long
Dim i As Long, DerniereLigne As Long
Dim NbCol As Long
Dim j As Long
Dim C As Range
Dim R As Range
'---
t = Timer
pas = 100 ' 200 'périodicité de la décharge
NbCol = [a1].CurrentRegion.Columns.Count
DerniereLigne = Sheets("Feuil1").Range("B65536").End(xlUp).Row
For i = 2 To DerniereLigne
  If i Mod pas = 0 Then _
    If Not R Is Nothing Then R.Interior.ColorIndex = 6: Set R = Nothing 'on colorise d'un seul coup
  For j = 3 To NbCol
    Set C = Sheets("Feuil1").Cells(i, j)
    If C <> "" Then

      If R Is Nothing Then
        Set R = C
      Else
        Set R = Application.Union(R, C)
      End If
  
      Exit For
    End If
  Next j
Next i
If Not R Is Nothing Then R.Interior.ColorIndex = 6  'ce qui reste à colorer
MsgBox Timer - t
End Sub

Durée d'exécution 3,2 secondes, on gagne 14% par rapport au test initial.

En fait ce qui prend du temps c'est l'analyse des cellules une par une, malgré le Exit For.

A+