2009-12-18 8 views
0

J'ai le code VBA pour sélectionner une plage de cellules sur la même ligne, puis fusionner & gauche justifier cette sélection.Merge et gauche justifient une plage de lignes dans Excel

Je voudrais l'améliorer pour me permettre de sélectionner une plage ou un bloc de rangées et d'effectuer la même action sur chaque rangée de la plage.

Répondre

0

est ici une façon de le faire:

  1. Récupère la dernière ligne peuplée de la feuille de calcul via an auxiliary function.

  2. Effectuez une itération sur les lignes et, pour chaque ligne, recherchez la dernière colonne utilisée via une autre fonction auxiliaire.

  3. Fusionner la sélection créée dynamiquement et aligner à gauche.

Important note from Microsoft: Seules les données dans la cellule supérieure gauche d'une plage (plage:. Deux ou plusieurs cellules sur une feuille Les cellules d'une plage peuvent être adjacentes ou non.) Des cellules sélectionnées resteront en la cellule fusionnée. Les données des autres cellules de la plage sélectionnée seront supprimées.

Option Explicit 

Sub merge_left_justify() 
    Dim i As Long 
    Dim j As Long 

    Dim last_row As Long 
    Dim last_col As Long 

    last_row = find_last_row(ThisWorkbook.ActiveSheet) 

    Application.DisplayAlerts = False 

    For i = 1 To last_row Step 1 
     j = find_last_col(ThisWorkbook.ActiveSheet, i) 
     Range(Cells(i, 1), Cells(i, j)).Select 
     Selection.Merge 
     Selection.HorizontalAlignment = xlLeft 
    Next i 

    Application.DisplayAlerts = True 
End Sub 

Function find_last_row(ByRef ws As Worksheet) 
    Dim last_row 
    last_row = Cells.Find(what:="*", after:=[a1], _ 
     searchorder:=xlByRows, searchdirection:=xlPrevious).row 
    find_last_row = last_row 
End Function 

Function find_last_col(ByRef ws As Worksheet, ByVal row As Long) 
    Dim last_col 
    last_col = Cells(row, 255).End(xlToLeft).Column 
    find_last_col = last_col 
End Function 
0

En fait, pour répondre à ma propre question, j'ai joué avec un code tout en cherchant de l'aide et est venu avec cela. Quelqu'un voit-il des problèmes avec cela? Semble fonctionner, sauf que j'ai toujours un problème avec l'instruction IF qui est censée ignorer et ne pas fusionner une ligne vide, donc c'est juste commenté ici.

Sub MergeLeft() 

    Dim range As range 
    Dim i As Integer 
    Dim RowCount As Integer 

    ' Merge Macro 
    ' Keyboard Shortcut: Ctrl+Shift+A 

    RowCount = Selection.Rows.Count 
    For i = 1 To RowCount 
     Set range = Selection.Rows(i) 
     'If range(i) <> "" Then 
     With range 
      .HorizontalAlignment = xlLeft 
      .VerticalAlignment = xlBottom 
      .WrapText = False 
      .Orientation = 0 
      .AddIndent = False 
      .IndentLevel = 0 
      .ShrinkToFit = False 
      .ReadingOrder = xlContext 
      .MergeCells = False 
     End With 
     range.Merge 
     'End If 
    Next i 

End Sub 
0

Pourquoi ne pas utiliser Merge Across? C'est un outil intégré dans la liste déroulante de fusion. Si vous avez besoin de modifier le fonctionnement de Merge, vous pouvez également utiliser .Merge (Across)

Questions connexes