Microsoft 365 Obtenir le numéro de ligne de la prochaine cellule non vide dans une colonne

bioteau

XLDnaute Nouveau
Bonjour à tous,

Dans une feuille, je dois mettre en forme un tableau avec ligne et totaux. Les données du tableau proviennent d'un TCD d'une autre feuille, le remplissage est donc variable sauf la ligne 2 préremplie et donc fixe.
Je dois donc déterminer l'emplacement de certaines données dans ce tableau afin d'encadrer correctement celui-ci.
Pour vérifier la bonne valeur de mes variables j'ai fait apparaître des messages box tout au long de ma macro. Cela m'a permis de voir qu'elle variable était mal renseignée donc mal définie.
2 variables sont mal définies mais en fait correspondent à la même recherche savoir : DETERMINER LA PROCHAINE CELLULE NON VIDE DE LA COLONNE B
J'utilise :
Range("B2").End(xldown).Row
En fait, cela donne la dernière cellule non vide en partant du haut et non la prochaine cellule non vide en partant du haut.
J'ai essayé avec Find sans succès.
J'ai joint un fichier simplifié pour plus de commodité et vision sur la macro, j'ai enlevé la boucle puisque le problème est ciblé.

Normalement je devrais avoir les valeurs suivantes pour les variables:
DERLIGNE1 = 9 (ok)
LIGDEP = 3 --> j'ai actuellement 4
LIGDEP = 4 --> j'ai actuellement 6
BAS = 3 --> j'ai actuellement 5

Merci d'avance pour votre aide
 

Pièces jointes

  • TEST1.xlsm
    26.9 KB · Affichages: 15
Solution
Bonjour bioteau, le forum,
il faut que je fasse la somme du poids par client dans la colonne E.
Voyez ce fichier (2) et la macro complétée :
VB:
Sub Fusionner()
Dim a As Range, i&
With [B2].CurrentRegion
    .UnMerge 'défusionne
    If Application.CountBlank(.Columns(1)) Then
        For Each a In .Columns(1).SpecialCells(xlCellTypeBlanks).Areas
            With Union(a.Cells(0, 1), a)
                .Merge 'fusionne en colonne B
                Intersect(.EntireRow, [E:E]).Merge 'fusionne en colonne E
            End With
        Next
    End If
    '---somme et bordures---
    .Borders.LineStyle = xlNone 'RAZ
    For i = 1 To .Rows.Count
        If .Cells(i, 1) <> "" Then
            With Intersect(.Cells(i...

soan

XLDnaute Barbatruc
Inactif
Bonsoir bioteau,

ton fichier en retour. :)

clique sur le bouton "LANCEMENT MACRO" ➯ travail effectué ! 😊

VB:
Option Explicit

Sub Essai()
  If ActiveSheet.Name <> "TEST" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 2).End(3).Row: If n = 2 Then Exit Sub
  'MISE EN FORME DU TABLEAU : BORDURE ET CENTRAGE
  Dim i As Byte: Application.ScreenUpdating = 0
  With Range("B3:B" & n)
    For i = 7 To 10
      If i <> 8 Then .Borders(i).LineStyle = 1
    Next i
    .HorizontalAlignment = 3
  End With
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • TEST1.xlsm
    21 KB · Affichages: 5

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Range("B2").End(xldown).Row
Le problème avec cette instruction c'est qu'elle dépend du contenu de B2...😕

Si B2 est vide, tu obtiendras la première ligne non vide.
Mais si B2 n'est pas vide, alors ça dépend du contenu de B3...

Donc une possibilité est de "scanner" chaque cellule de la colonne.
Une autre possibilité serait peut-être d'insérer une ligne vide, utiliser ton instruction pour obtenir le numéro de ligne de la première cellule non vide, supprimer la ligne insérée, retrancher 1 au numéro de ligne obtenu. Mais ce n'est pas très simple...

Une autre possibilité pourrait éventuellement être de ne pas passer par du VBA mais par une MFC.
 

bioteau

XLDnaute Nouveau
Bonjour Soan et Marcel,
Soan, merci pour ton aide mais cela ne correspond pas à ce que je recherche. Je pense que ma demande n'était pas assez explicite.
Je renvoie mon fichier pour plus de clarté sur ce que je veux obtenir.
Marcel, la ligne 2 est toujours renseignée par contre je ne peux insérer une ligne vide. La piste "scanner" chaque cellule de la colonne est une solution et justement c'est ce que je recherche sans succès.
Pour être plus précis la colonne B n'est qu'une partie de mon tableau à mettre en forme, la colonne C,D,E,F contient également des infos et il faut donc que j'arrive à mettre des bordures autour des cellules d'un même client(en VBA car cette phase de mise en forme fait partie d'un ensemble de procédure).
 

Pièces jointes

  • TEST1.xlsm
    27.8 KB · Affichages: 5

TooFatBoy

XLDnaute Barbatruc
Oui, j'avais bien compris ce que tu avais demandé, mais n'ayant pas d'Excel je ne peux te donner une macro toute faite. 😔

J'essayai d'expliquer pourquoi tu ne trouvais pas le bon numéro de ligne avec ton instruction.
Mais j'avais aussi compris que B2 était forcément rempli puisque c'est un en-tête de colonne, donc je proposais d'insérer temporairement une ligne vide, puis utiliser l'instruction range.end(xldown) pour trouver la bonne ligne, et en suite supprimer la ligne vide précédemment insérée.

Pour scanner les cellules de la colonne B, tu commences par rechercher la dernière cellule non vide de la colonne B (voir macro du camarade Soan : instruction n=...), en suite tu n'as plus qu'à utiliser une boucle FOR allant de 3 à n.
Mais je viens de penser qu'avec cette méthode, il va y avoir un problème avec la dernière personne... il faut donc trouver la vraie dernière ligne, c'est-à-dire la dernière ligne de ton tableau (qui n'est pas forcément la dernière ligne de la colone B) avec une autre méthode. Peut-être avec CurrentRegion, ou en utilisant un tableau structuré.

Bref, comme dit plus haut, sans PC je ne peux qu'essayer de t'indiquer des pistes de recherche, mais ne saurais te donner une macro toute faite. Désolé.
Mais heureusement, d'autres ici sauront t'aider plus efficacement.

@+
 

job75

XLDnaute Barbatruc
Bonjour bioteau, soan, Marcel32,

La macro affectée au bouton :
VB:
Sub Fusionner()
Dim a As Range, i&
With [B2].CurrentRegion
    .UnMerge 'défusionne
    If Application.CountBlank(.Columns(1)) Then
        For Each a In .Columns(1).SpecialCells(xlCellTypeBlanks).Areas
            Union(a.Cells(0, 1), a).Merge 'fusionne
        Next
    End If
    '---bordures---
    .Borders.LineStyle = xlNone 'RAZ
    For i = 1 To .Rows.Count
        If .Cells(i, 1) <> "" Then
            With Intersect(.Cells(i, 1).MergeArea.EntireRow, .Cells)
                .BorderAround Weight:=xlThin  'pourtour
                .Borders(xlInsideVertical).Weight = xlThin
            End With
        End If
    Next
End With
End Sub
Edit : j'avais oublié .Areas à la 6ème ligne.

A+
 

Pièces jointes

  • TEST(1).xlsm
    25.1 KB · Affichages: 3
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour bioteau, Marcel32, job75,

je te retourne le fichier de ton post #4. 🙂

clique sur le bouton "LANCEMENT MACRO" ➯ travail effectué ! 😊

VB:
Option Explicit

Sub TEST()
  If ActiveSheet.Name <> "TEST" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 3).End(3).Row: If n = 2 Then Exit Sub
  Dim a&, b&, i As Byte: a = n + 1: Application.ScreenUpdating = 0
  With Range("B3:D" & n)
    For i = 7 To 11
      If i <> 8 Then .Borders(i).LineStyle = 1
    Next i
  End With
  Do
    a = a - 1: b = a
    Do While IsEmpty(Cells(a, 2)): a = a - 1: Loop
    If a > 3 Then Cells(a, 2).Resize(, 3).Borders(8).LineStyle = 1
    If a < b Then
      With Range(Cells(a, 2), Cells(b, 2))
        .VerticalAlignment = 2: .Merge
      End With
    End If
  Loop Until a = 3
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • TEST1.xlsm
    23 KB · Affichages: 4

bioteau

XLDnaute Nouveau
Bonjour Soan, bonjour JOB 75
Merci beaucoup, les 2 propositions fonctionnent. Je vais l'inclure dans le module complet pour être certain que cela répond parfaitement aux différents cas.
Je comprends le code de JOB75 et j'essaye de "déchiffrer" celui de SOAN.... pas simple. Si tu peux me donner quelques explications, cela me permettra de progresser dans mon apprentissage du VBA.
En tout cas merci encore cela va me permettre de finaliser mon projet.
 

soan

XLDnaute Barbatruc
Inactif
Bonjour bioteau, le fil,

j'essaye de "déchiffrer" celui de SOAN.... pas simple. Si tu peux me donner quelques explications, cela me permettra de progresser dans mon apprentissage du VBA.

If ActiveSheet.Name <> "TEST" Then Exit Sub : la feuille active doit être la feuille "TEST" ; c'est forcément le cas si ton classeur contient uniquement cette feuille, mais au cas où ton fichier réel comporterait plus d'une feuille, je préfère mettre cette précaution ; d'un autre côté c'était utile quand j'avais mis un raccourci clavier Ctrl e pour lancer la macro : c'est plus simple qu'un clic sur le bouton "LANCEMENT MACRO" ; note bien ceci : quand on clique sur ce bouton, la feuille "TEST" est forcément la feuille active puisque le bouton est situé sur cette feuille ; mais : a) avec Ctrl e, ça pourrait être une autre feuille ! b) même si j'ai enlevé ensuite le raccourci Ctrl e, l'utilisateur peut lancer la macro via la fenêtre des macros (Alt F8), et dans ce cas aussi, ça pourrait être une autre feuille ! grâce à ce test If la macro s'arrêtera aussitôt si la feuille active est autre que "TEST" ; donc pour la suite du code VBA, toute référence de cellule sans référence explicite de feuille sera une cellule de la feuille active, donc de la feuille "TEST".​

Dim n& : idem que Dim n As Long

n = Cells(Rows.Count, 3).End(3).Row : idem que n = Cells(Rows.Count, "C").End(xlUp).Row : dernière ligne utilisée, selon la colonne C ; ici, n = ligne n° 11.

If n = 2 Then Exit Sub : si ton tableau ne contenait aucune donnée (ce qui est le cas au début, quand tu commences à le faire), la dernière ligne serait alors la ligne d'en-têtes, qui est la ligne n° 2 ; or dans ce cas, y'a rien à faire ➯ on quitte la sub si n = 2.

Dim a&, b&, i As Byte : déclaration de 3 autres variables

a = n + 1 : a = n + 1 = 11 + 1 = 12

Application.ScreenUpdating = 0 : désactive la mise à jour de l'écran ➯ exécution plus rapide​



With Range("B3:D" & n) .. End With : avec la plage B3: D11

For i = 7 To 11 .. Next i : boucle i de 7 à 11

If i <> 8 Then : avec ce test, sauf pour i = 8, donc pour : 7 ; 9 ; 10 ; 11

.Borders(i).LineStyle = 1 : on met un trait pour B3: D11, et pour la bordure de type i :

* Borders(7) = Borders(xlEdgeLeft) = bordure gauche

* Borders(9) = Borders(xlEdgeBottom) = bordure bas

* Borders(10) = Borders(xlEdgeRight) = bordure droite

* Borders(11) = Borders(xlInsideVertical) = bordure interne verticale

si la macro se terminait ici, on aurait :

Image.jpg


c'est donc la moitié du travail qui est déjà faite ! 😊 mais le plus dur reste à faire ! 😭 c'est-à-dire mettre les lignes horizontales internes aux bons emplacements, donc pas pour n'importe quelle ligne ! 😜

je te laisse lire déjà tout ça ; la suite du feuilleton sera dans mon prochain post. 😄 comme tu viens de le voir ci-dessus, une bonne explication détaillée est très longue à faire ! donc ça va beaucoup tarder avant que tu puisses voir le prochain épisode ! 😁 😀 (même si tu t'abonnes à la TNT et au fibre)

soan
 
Dernière édition:

bioteau

XLDnaute Nouveau
Merci beaucoup Soan et bravo pour la mise en forme, c'est très agréable et rend la lecture ludique. Cela donne envie de lire le prochain épisode 😉.
La suite me donnera peut être la clée pour terminer, il faut que je fasse la somme du poids par client dans la colonne E. Pour le moment j'arrive à faire la somme de 2 lignes mais pas plus.
 

job75

XLDnaute Barbatruc
Bonjour bioteau, le forum,
il faut que je fasse la somme du poids par client dans la colonne E.
Voyez ce fichier (2) et la macro complétée :
VB:
Sub Fusionner()
Dim a As Range, i&
With [B2].CurrentRegion
    .UnMerge 'défusionne
    If Application.CountBlank(.Columns(1)) Then
        For Each a In .Columns(1).SpecialCells(xlCellTypeBlanks).Areas
            With Union(a.Cells(0, 1), a)
                .Merge 'fusionne en colonne B
                Intersect(.EntireRow, [E:E]).Merge 'fusionne en colonne E
            End With
        Next
    End If
    '---somme et bordures---
    .Borders.LineStyle = xlNone 'RAZ
    For i = 1 To .Rows.Count
        If .Cells(i, 1) <> "" Then
            With Intersect(.Cells(i, 1).MergeArea.EntireRow, .Cells)
                If i > 1 Then .Columns(4) = Application.Sum(.Columns(3)) 'somme
                .BorderAround Weight:=xlThin  'pourtour
                .Borders(xlInsideVertical).Weight = xlThin
            End With
        End If
    Next
End With
End Sub
PS : au post #7 j'avais oublié .Areas en ligne 6 de la macro, j'ai corrigé.

A+
 

Pièces jointes

  • TEST(2).xlsm
    26.1 KB · Affichages: 6

Discussions similaires