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

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

cdefghi 

任何想法从哪里开始？ 目前我有两个macros：一个在选定的组下面创build一个组，另一个在选定的行下面创build一个行。 我在想，当创build一个新的行，我可以以某种方式将列b等同于我的新行上面最接近的合并单元格。

我怎样才能find选定的行上方最接近的合并单元格？

创build一个新行的代码如下：

 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