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

loulou14

XLDnaute Nouveau
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é

Code:
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
 

Pièces jointes

  • Classeur1.xlsm
    19.6 KB · Affichages: 43

phlaurent55

Nous a quittés en 2020
Repose en paix
Bonjour loulou,

avec ce code:

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

XLDnaute Nouveau
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

XLDnaute Accro
Bonjour,

Peut être comme cela :
VB:
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

Nous a quittés en 2020
Repose en paix
Re,

Re,

ou peut-être comme ceci,

Code:
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
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour loulou14, Philippe, Patrick,

On peut se passer de macro avec cette MFC sur C2:K18 :
Code:
=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+
 

Pièces jointes

  • MFC(1).xlsx
    17.7 KB · Affichages: 34
Dernière édition:

job75

XLDnaute Barbatruc
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) :
Code:
=($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+
 

Pièces jointes

  • MFC(3).xlsx
    18 KB · Affichages: 37

job75

XLDnaute Barbatruc
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

XLDnaute Accro
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.
VB:
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re,

Avec cette macro le pas de décharge optimal est de 100 :
Code:
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+
 

Discussions similaires

Réponses
0
Affichages
206

Statistiques des forums

Discussions
312 895
Messages
2 093 383
Membres
105 714
dernier inscrit
POKITO