识别合并单元格中的第一行和最后一行

Question

我正在将一些条件格式应用于涉及一些复杂指标的 Excel 工作表，因此决定使用 VBA 进行此方法。

由于电子表格的布局方式，L1 和 L0 包含在合并的单元格中。我需要一种方法来识别一组合并单元格中的第一行和最后一行，下面的代码不起作用，因为我处于恒定循环状态。我需要一种方法来查看找到的合并单元格，然后识别该合并单元格区域中的第一行和最后一行。当前代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim I As Integer, J As Integer
Dim LastRow As Long, L0FirstMergedRow As Long, L0LastMergedRow As Long, L1FirstMergedRow As Long, L1LastMergedRow As Long
Dim Baseline As Long, Forecast As Long, Balance As Long, Actual As Long
Dim Baselinerng As Range, Forecastrng As Range, ActualRng As Range
Dim MaximumBaseline As Double, MaximumForecast As Double, MaximumActual As Double
Dim r As Long, actualvalue As Long

LastRow = ThisWorkbook.Worksheets("Status Report").Cells(Rows.Count, "F").End(xlUp).Row

actualvalue = 0

For I = 3 To LastRow

    'Code looks for merged cells and marks the row numbers
    If ThisWorkbook.Worksheets("Status Report").Cells(I, 3).MergeCells = True Then

        L1FirstMergedRow = I
        L1LastMergedRow = I + ThisWorkbook.Worksheets("Status Report").Cells(I, 3).MergeArea.Cells.Count

    'Set ranges of Baseline, Forecast and Actual cells
        Set Baselinerng = ThisWorkbook.Worksheets("Status Report").Range(Cells(L1FirstMergedRow, 6), Cells(L1LastMergedRow, 6))
        Set Forecastrng = ThisWorkbook.Worksheets("Status Report").Range(Cells(L1FirstMergedRow, 7), Cells(L1LastMergedRow, 7))
        Set ActualRng = ThisWorkbook.Worksheets("Status Report").Range(Cells(L1FirstMergedRow, 8), Cells(L1LastMergedRow, 8))

        MaximumBaseline = Application.WorksheetFunction.Max(Baselinerng)
        MaximumForecast = Application.WorksheetFunction.Max(Forecastrng)
        MaximumActual = Application.WorksheetFunction.Max(ActualRng)

    'Code looks for values in Actuals Column before it executes.
        For J = L1FirstMergedRow To L1LastMergedRow
                If ThisWorkbook.Worksheets("Status Report").Cells(J, 8).Value <> "" Then
                    actualvalue = actualvalue + 1
                End If
        Next J

    ' Colour Cells Blue based on calculation of Actual dates
        If actualvalue = L1LastMergedRow - L1FirstMergedRow + 1 Then
            ThisWorkbook.Worksheets("Status Report").Cells(I, 3).Interior.Color = RGB(0, 102, 255)
        End If

        If MaximumActual = 0 Then

            If MaximumBaseline <> 0 And MaximumForecast <> 0 Then
                Balance = MaximumForecast - MaximumBaseline
            Else
                GoTo NextLoop2:
            End If

            If MaximumBaseline <= MaximumForecast Then
                ThisWorkbook.Worksheets("Status Report").Cells(I, 3).Interior.Color = RGB(0, 176, 80)
            End If

            If MaximumBaseline < MaximumForecast And Balance <= 5 Then
                ThisWorkbook.Worksheets("Status Report").Cells(I, 3).Interior.Color = RGB(255, 192, 0)
            End If

            If MaximumBaseline < MaximumForecast And Balance > 5 Then
                ThisWorkbook.Worksheets("Status Report").Cells(I, 3).Interior.Color = RGB(255, 0, 0)
                ThisWorkbook.Worksheets("Status Report").Cells(I, 3).Interior.Color = RGB(255, 0, 0)
            End If

        Else
        GoTo NextLoop2:

        End If
    End If

NextLoop2:
Next I

Answer 1

考虑这个例子：

Set MyMergedRange = Range("d20").MergeArea
FirstRow = MyMergedRange.Row
LastRow = MyMergedRange.Row + MyMergedRange.Rows.Count - 1