如何在列合併單元格，如果上述細胞具有內容，但本身是空白

Question

這裏是麻煩我：

對於細胞在P列，例如P3，如果兩個P2 & B3不爲空，但P3爲空白，然後將P2與P3合併。然後進入列P中的下一個單元格，直到列B中的相應單元格（例如：B8）爲空，然後停止。

 B  ....  P 
1 Monitor   Tom 
2 Mouse    Ann 
3 Keyboard 
4 Sticker 
5 Speaker   John 
6 Cable 
7 Fan    Rose 
8 

因此，對於上面的表格，我想合併P2：P4 P5 &：P6。 我已經嘗試了幾次與我可憐的vba技能，但失敗...

此代碼是我在這個網站上找到，我試圖編輯它，看看這是否可以解決我的問題，但它不工作...

Sub Merge() 
LR = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row 
For i = 1 To LR 
If ActiveSheet.Cells(i, 1).Value <> "" And ActiveSheet.Cells(i + 1, 1).Value = "" And ActiveSheet.Cells(i + 1, 2).Value <> "" Then 
    u = i + 1 
    Do While ActiveSheet.Cells(u, 1).Value = "" And ActiveSheet.Cells(u, 2) <> "" 
     u = u + 1 
    Loop 
    ActiveSheet.Range("A" & i & ":A" & (u - 1)).Select 
    With Selection 
     .Merge 
     .BorderAround Weight:=xlMedium 
     .WrapText = True 
     '.VerticalAlignment = x1VAlignTop 
     '.HorizontalAlignment = xlLeft 
    End With 
    Sheets(DataSheet).Range("B" & i & ":B" & (u - 1)).BorderAround Weight:=xlMedium 
    i = u + 1 
End If 

下一頁我 結束小組

Answer 1

試試這個：

Dim i As Integer, a As String, b As String, c As Integer, d As Integer 
i = 11 
a = "B" 
b = "P" 
c = 0 
d = 0 
While Range(a & i) <> "" 
    If Range(b & i) = "" Then 
     If c = 0 And i > 1 Then 
      c = i - 1 
      d = 1 
     Else 
      d = d + 1 
     End If 
    Else 
     If c > 0 And d > 0 Then 
      Range(b & c & ":" & b & (c + d)).Merge 
     End If 
     c = 0 
     d = 0 
    End If 
    i = i + 1 
Wend 
If c > 0 And d > 0 Then 
    Range(b & c & ":" & b & (c + d)).Merge 
End If