Объедините и оставьте выравнивать ряд строк в Excel - PullRequest
Новая
       16

Объедините и оставьте выравнивать ряд строк в Excel

0 голосов
/ 19 декабря 2009

У меня есть код VBA, чтобы выбрать диапазон ячеек в той же строке, а затем объединить и уложить влево, чтобы подтвердить выбор.

Я хотел бы улучшить его, чтобы позволить мне выбирать диапазон или блок строк и выполнять одно и то же действие для каждой строки в диапазоне.

Ответы [ 3 ]

0 голосов
/ 19 декабря 2009

На самом деле, чтобы ответить на свой вопрос, я поигрался с кодом, ища помощи, и придумал это. Кто-нибудь видит какие-либо проблемы с этим? Кажется, работает, за исключением того, что у меня все еще есть проблема с оператором IF, который должен игнорировать и не объединять пустые строки, поэтому он просто закомментирован здесь. 

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 голосов
/ 27 ноября 2014

Почему бы не использовать Merge Across? Это встроенный инструмент в раскрывающемся списке слияния. Если вам нужно настроить способ слияния, вы также можете использовать .Merge (через)

0 голосов
/ 19 декабря 2009

Вот один из способов сделать это:

  1. Получить последнюю заполненную строку на листе с помощью вспомогательной функции .

  2. Выполните итерацию по строкам, и для каждой строки найдите последний столбец, использованный с помощью другой вспомогательной функции.

  3. Объединить полученное динамически созданное выделение и выровнять по левому краю.

Важное примечание от Microsoft : Только данные в верхней левой ячейке диапазона (диапазон: две или более ячеек на листе. Ячейки в диапазоне могут быть смежными или несмежными.) выбранные ячейки останутся в объединенной ячейке. Данные в других ячейках выбранного диапазона будут удалены. 

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
...