如何使用VBA检测选择行上方的合并单元格？

Question

从下图中，我想写一个vba，其中b列中的单元格将等于上面的组。因此，例如，活动1.1和活动1.2的列b将等于组1，活动2.1和活动2.2的列b将等于组2.

c d     e                   f                          g           h       i

关于从哪里开始的任何想法？目前我有两个宏：一个在选定组下面创建一个组，另一个在所选行下面创建一个线。我在想，在创建新行时，我可以将列b等同于新行上方最近的合并单元格。

如何找到所选行上方最近的合并单元格？

创建新行的代码如下：

Sub newLine()

Dim currCell As Integer
Dim newCell As Integer
currCell = ActiveCell.Select
Selection.Offset(1).EntireRow.Insert
ActiveCell.Offset(1, 0).Select

Cells(Selection.Row, 3).FormulaR1C1 = "=IF(RC4=""Complete"",1,IF(RC4=""Late"",2,IF(RC4=""At Risk"",3,IF(RC4=""On Schedule"",4,5))))"

With Cells(Selection.Row, 3)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=1"
.FormatConditions(1).Interior.Color = RGB(0, 112, 192)
.FormatConditions(1).Font.Color = RGB(0, 112, 192)

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=2"
.FormatConditions(2).Interior.Color = RGB(192, 0, 0)
.FormatConditions(2).Font.Color = RGB(192, 0, 0)

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=3"
.FormatConditions(3).Interior.Color = RGB(255, 192, 0)
.FormatConditions(3).Font.Color = RGB(255, 192, 0)

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=4"
.FormatConditions(4).Interior.Color = RGB(146, 208, 80)
.FormatConditions(4).Font.Color = RGB(146, 208, 80)

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=5"
.FormatConditions(5).Interior.Color = RGB(255, 255, 255)
.FormatConditions(5).Font.Color = RGB(255, 255, 255)
End With

Cells(Selection.Row, 4).Select
   With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Complete, Late, At Risk, On Schedule"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Select Status"
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With


Cells(Selection.Row, 4) = "[Enter Status]"
Cells(Selection.Row, 4).HorizontalAlignment = xlLeft

Cells(Selection.Row, 5) = "[Enter Activity]"
Cells(Selection.Row, 5).HorizontalAlignment = xlLeft
Cells(Selection.Row, 6) = "[Enter Task]"
Cells(Selection.Row, 6).HorizontalAlignment = xlLeft
Cells(Selection.Row, 7) = "[Enter Responsability]"
Cells(Selection.Row, 7).HorizontalAlignment = xlLeft
Cells(Selection.Row, 8) = "[Enter Start Date]"
Cells(Selection.Row, 8).HorizontalAlignment = xlRight
Cells(Selection.Row, 9) = "[Enter Comp Date]"
Cells(Selection.Row, 9).HorizontalAlignment = xlRight

Range(Cells(Selection.Row, 4), Cells(Selection.Row, 9)).Font.Bold = False
Range(Cells(Selection.Row, 4), Cells(Selection.Row, 9)).Font.Size = 8
Range(Cells(Selection.Row, 4), Cells(Selection.Row, 9)).RowHeight = 11.25
Range(Cells(Selection.Row, 4), Cells(Selection.Row, 7)).HorizontalAlignment = xlLeft
Range(Cells(Selection.Row, 4), Cells(Selection.Row, 7)).NumberFormat = "General"

Range(Cells(Selection.Row, 8), Cells(Selection.Row, 9)).HorizontalAlignment = xlRight
Range(Cells(Selection.Row, 8), Cells(Selection.Row, 9)).NumberFormat = "m/d/yyyy"
End Sub

有什么想法吗？

谢谢！

Answer 1

MergeCells可以帮助你。

Sub WhichLineIsMerged()

    Dim row As Long

    For row = ActiveCell.row To 1 Step -1

        If Cells(row, 1).MergeCells Then

            MsgBox "There are merged cells in row " & row

        End If

    Next row

End Sub

此子程序仅检查每行上的一个单元格。如上所述，它会检查A列。您可以根据需要进行调整。

Answer 2

如果有人有兴趣，我就是这样解决的：

Sub testGroupNum()
Dim i As Long
Dim LastRow As Integer
Dim startRow As Integer

LastRow = Cells(Rows.Count, "H").End(xlUp).Row
startRow = Selection.Row

For i = startRow To 11 Step -1
If Cells(i, 4).MergeCells = True Then
Cells(startRow, 2) = Cells(i, 4)
Exit For
End If
Next
End Sub