Question

我正在Excel中构建一个日历，自动将事件信息从表格映射到动态日历视图。每行代表从上午8点到下午6点的时间，每列代表从星期日到星期六的星期几。我能够将每个唯一事件的信息映射到每列中的两个单独的单元格，一个用于开始时间，一个用于结束时间。我正在寻找帮助构建一个宏来合并包含相同信息的单元格，以便日历具有凝聚力。例如。事件A从上午9点开始，到上午11点结束。目前有一个小区在上午9点填充，一个在上午11点，但是10AM的小区是空白的，我想将两个填充的小区从9AM小区合并到11AM小区。由于填充的单元格并不总是相邻，因此在这种情况下，偏移功能似乎不起作用。

以下是我试图完成的伪代码：

对于指定区域中的每一列
遍历每一行
如果两个单元格包含相同的文本
合并这两个单元格

到目前为止，我已经设法提供了一些代码。您可以看出存在许多差距，可能还有语法错误：

Sub MergeCells
Dim cells As String
cells = ActiveSheet.Range("C8:V28,C31:V51,C54:V74,C77:V97,C100:V120")
    If ActiveSheet.Range(cells).??? Then
       ActiveSheet.Range(cells).Merge
    End If 
End Sub

非常感谢任何帮助！

Before picture

After picture

Answer 1

好的 - 这可能有点矫枉过正，你可能需要调整，但这很有趣。

Sub combine_Same()
Application.DisplayAlerts = False

Dim tableRng As Range
Dim i As Long, k As Long, lastRow As Long
Dim curText As Range, prevText As Range

Dim tableRanges As Variant

tableRanges = Split("b3:e20,C31:V51,C54:V74,C77:V97,C100:V120", ",")

Dim rng     As Long

For rng = LBound(tableRanges) To UBound(tableRanges)
    Debug.Print "Working with: " & tableRanges(rng)
    Set tableRng = Range(tableRanges(rng))
'    tableRng.Select
    lastRow = tableRng.Rows(tableRng.Rows.Count).Row
    For k = tableRng.Columns(1).Column To tableRng.Columns.Count
        For i = lastRow To tableRng.Rows(1).Row Step -1
            Set curText = Cells(i, k)
            Set prevText = curText.End(xlUp)
            If curText.Value = prevText.Value And Not IsEmpty(curText) Then
                'curText.Select
                Range(curText, prevText).Merge
                curText.VerticalAlignment = xlCenter
            ElseIf curText.Value = curText.Offset(-1, 0).Value And Not IsEmpty(curText) Then
                'curText.Select
                Range(curText, curText.Offset(-1, 0)).Merge
                curText.VerticalAlignment = xlCenter
            End If
        Next i
    Next k
Next rng
Application.DisplayAlerts = True
End Sub

VBA合并Excel中

1 个答案: