如果上面的单元格有内容但本身是空白的，如何合并列中的单元格

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