VBA在Excel中合併包含相同文本的非相鄰單元格

Question

我在Excel中創建了一個自動將日曆信息從表格映射到動態日曆視圖的日曆。每行表示從上午8點到下午6點的時間，每列表示週日至週六的一週中的某一天。我能夠將每個獨特事件的信息映射到每個列中的兩個單獨的單元格，一個用於開始時間，另一個用於結束時間。我正在尋找幫助，建立一個宏來合併包含相同信息的單元格，以便日曆具有內聚性。例如。活動A從上午9點開始，於上午11點結束。目前在上午9點有一個單元，上午11點有一個單元，但10點的單元是空白的，我想將9AM單元中的兩個單元合併到11AM單元。由於填充的單元格不總是相鄰的，所以在這種情況下，偏移函數似乎不起作用。

這裏是我想要實現的僞代碼：

1. 對於每一列在指定區域
2. 循環的每一行
3. 如果兩個細胞都含有相同的文字
4. 合併這些兩個單元

這裏是代碼的一點我已經成功地拿出這麼遠。你可以知道有很多差距，可能是語法錯誤：

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