vba 在 Excel 中合并和左对齐一系列行

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/1930663/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 11:07:51  来源:igfitidea点击:

Merge and Left Justify a Range of Rows in Excel

excelvbamergerange

提问by Craig

I have VBA code to select a range of cells on the same row and then merge & left justify that selection.

我有 VBA 代码来选择同一行上的一系列单元格,然后合并并左对齐该选择。

I would like to enhance it to allow me to select a range or block of rows and perform the same action on each row in the range.

我想增强它以允许我选择一个范围或行块并对范围中的每一行执行相同的操作。

回答by mechanical_meat

Here's one way to do it:

这是一种方法:

  1. Get the last populated row in the worksheet via an auxiliary function.

  2. Iterate over the rows, and for each row find the last column used via another auxiliary function.

  3. Merge the resulting dynamically created selection and align left.

  1. 通过辅助函数获取工作表中最后填充的行。

  2. 遍历行,并为每一行找到通过另一个辅助函数使用的最后一列。

  3. 合并生成的动态创建的选择并左对齐。

Important note from Microsoft: Only the data in the upper-left cell of a range (range: Two or more cells on a sheet. The cells in a range can be adjacent or nonadjacent.) of selected cells will remain in the merged cell. Data in other cells of the selected range will be deleted.

来自 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

回答by Craig

Actually to answer my own question, I played around with some code while looking for help and came up with this. Anyone see any issues with this? Seems to work except I still have a problem with the IF statement that is supposed to ignore and not merge any row that is blank, so it's just commented out here.

实际上,为了回答我自己的问题,我在寻求帮助时尝试了一些代码并提出了这个问题。有人看到这有什么问题吗?似乎可以工作,但我仍然对 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

回答by Kman

Why not use Merge Across? Its a built-in tool under the merge dropdown. If you need to tweak the way Merge works you could also use .Merge(Across)

为什么不使用 Merge Across?它是合并下拉菜单下的内置工具。如果您需要调整 Merge 的工作方式,您还可以使用 .Merge(Across)