Question

我正在获取1、2或3列（可能更多）中的数据。我需要每一行来合并各自行中的数据，而不会丢失任何列中的任何数据。

我设法将一些代码组合在一起，可以正确地合并单元格，但是对于所有包含数据的行，我都在努力使用此代码查看每一行并合并该行中的单元格。

这是我到目前为止的内容：

Sub JoinAndMerge()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells

Dim outputText As String
Const delim = " "

On Error Resume Next

For Each cell In Selection
outputText = outputText & cell.value & delim
Next cell
With Selection
.Clear
.Cells(1).value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With


End Sub

这就是我要设法使它遍历每一行的全部内容。

Sub JoinAndMerge2()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells

Dim outputText As String
Const delim = " "

On Error Resume Next

Dim cell_value As Variant
Dim counter As Integer
Dim xlastRow As Long
Dim xlastColumn As Long

xlastRow = Worksheets("Sheet48").UsedRange.Rows.Count
xlastColumn = Worksheets("Sheet48").UsedRange.Columns.Count

'Looping through A column define max value
For i = 1 To xlastRow
    'Row counter
    counter = 1

    'Take cell one at the time
    cell_value = ThisWorkbook.ActiveSheet.Cells(1, i).value

    For Each cell In Selection
    outputText = outputText & cell.value & delim
    Next cell
        With Selection
        .Clear
        .Cells(1).value = outputText
        .Merge
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With

    counter = counter + 1


Next i


End Sub

如何使它正确遍历每一行？
如果有帮助，请在左之前，右之后：

Answer 1

我从不建议合并单元格，但是如果您必须...

这是按行（由 Column A确定）和列动态的。每个合并大小取决于最右边非空白列的每一行。因此，某些合并的单元格将跨越2列，而某些单元格将跨越3列。如果您不希望出现这种情况，则需要找到已用尽的最大列并按该列索引进行合并

I.E。将MyCell.Resize(1, i -1).Merge替换为MyCell.Resize(1, MaxCol).Merge，其中MaxCol是您的最大已使用列。

Option Explicit

Sub Merger()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim MyCell As Range, Merged As String, i, iArr

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each MyCell In ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
    For i = 1 To ws.Cells(MyCell.Row, ws.Columns.Count).End(xlToLeft).Column
        Merged = Merged & Chr(32) & MyCell.Offset(, i - 1) 'Build String
    Next i
        MyCell.Resize(1, i - 1).Merge 'Merge
        MyCell = Right(Merged, Len(Merged) - 1) 'Insert String
        Merged = "" 'Reset string for next loop
        MyCell.HorizontalAlignment = xlGeneral
        MyCell.VerticalAlignment = xlCenter
        MyCell.WrapText = True
Next MyCell

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 2

不能过分强调。应避免合并单元格。

当拖动区域以填充单元格时，它们会造成破坏。他们打断双击自动填充，使复制和粘贴练习感到沮丧。它们会延迟开发，并始终增加公式和VBA代码的复杂性，同时为错误发生或错误被忽视提供了更多机会。

所以我敦促您重新考虑使用合并的单元格。

几乎要证明这一点，您将在下面的两个解决方案的几行中找到“ *****”。这些行中的每一行都需要唯一地处理。想知道为什么吗？您当前在第1行中拥有的合并单元格。合并后的单元格可能会导致这些行因错误而暂停或继续出现不希望有的结果，具体取决于哪个单元格地址实际保存第1行数据。

合并的单元格绝对是恐怖的，被认为是Excel中最大的罪过之一。

这里有两种不合并单元格的前进方式...

在VBA中（伪代码）

For (Columns, 2, LastColumn, Step 2)

   For(Rows, 3, LastRow)

      With Worksheet

         If .Cells(Row,Column) <> vbNullString then

            .cells(Row,Column-1)=.cells(Row,Column-1).Value2 _

                & StringDeliminator & .cells(Row,Column).Value2

         End If

      End with

   Next Rows

   Columns (Column).EntireColumn.Delete*****

Next Columns

在工作表中使用公式

添加新列C

在C3单元格中，使用公式

=If(A3<>"",C3=A3 & " " & B3,"")

向下拖动公式（如果需要，请复制到其他列）

Ctrl上移以选择所有公式

复制*****

粘贴特殊值*****

删除A和B列*****

在一种情况下，合并的单元格可以...

如果您处在困境中，那么您无能为力，因为您的经理不在乎您的工作是否与其分析师的自动化工具不兼容，并且拒绝接受跨选区中心作为可行的选择，因为“我知道中心在做什么，但它没有帮助，您必须合并单元格以使文本在这些列上居中”。首先，开始寻找其他工作（或晋升至经理以上的职位，您的公司应该已经在寻找它）；其次，将损坏的合并单元版本提交到雪花中，并将功能版本完全滑交给分析人员作为初步估算

这是我唯一一次授权您使用合并的单元格。

逐行合并单元格而不会丢失任何数据

2 个答案:

我从不建议合并单元格，但是如果您必须...