获取列表中连续数据的多个实例的第一行和最后一行 headers- Excel

Obtaining first and last row headers for multiple instances of consecutive data in a list- Excel

我在 Excel 中有一个年历,大致如下:

-- 汤姆 -- 迪克 -- 哈利

1 -- x ----------------

2 -- x ----------------

3 -- x ----------------

4 ------x------------

5 ------x------------

6 --------x------------

7 x----------------x

8 x-----------------x

9 x-----------------x

我的数据由空白单元格组成,后面是连续条目组。

我想提取并显示与每组条目关联的第一个和最后一个日期。所以理想情况下函数的输出应该是:

  1. 汤姆:1 到 3 & 7 到 9
  2. 迪克:5 到 8
  3. 哈利:9 比 12

或类似的东西!

涉及 VBA 或本机 excel 函数的解决方案将不胜感激。

Thank-you一切为了你的时间!

示例数据:

宏:

Sub Test()

Dim i As Long, j As Long, k As Long
Dim mystring As String

For j = 2 To 4 'columns
    For i = 2 To 13 'rows
        If Cells(i, j).Value = "x" Then
            For k = i + 1 To 13 + 1
                If Not Cells(k, j).Value = "x" Then
                    If mystring = "" Then
                        mystring = Cells(1, j).Value & " " & i - 1 & " to " & k - 2
                        i = k - 1
                        Exit For
                    Else
                        mystring = mystring & " & " & Cells(1, j).Value & " " & i - 1 & " to " & k - 2
                        i = k - 1
                        Exit For
                    End If
                End If
            Next k
        End If
    Next i
    Worksheets("Sheet2").Range("A" & j - 1).Value = mystring
    mystring = ""
Next j

End Sub

立即window:

你可以使用这个 Function():

Function ExtractFirstAndLast(colIndex As Long)
    Dim area As Range

    With Range(Cells(1, colIndex), Cells(Rows.Count, colIndex).End(xlUp))
        .AutoFilter field:=1, Criteria1:="<>"
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            ExtractFirstAndLast = .Cells(1, 1) & ":"
            For Each area In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas
                ExtractFirstAndLast = ExtractFirstAndLast & " " & Cells(area.Rows(1).row, 1) & " to " & Cells(area.Rows(area.Rows.Count).row, 1) & " &"
            Next
            ExtractFirstAndLast = Left(ExtractFirstAndLast, Len(ExtractFirstAndLast) - 2)
        End If
        .AutoFilter
    End With
    ActiveSheet.AutoFilterMode = False
End Function

由您的 "main" 子调用:

Sub main()
    MsgBox ExtractFirstAndLast(4) ' this would return "Harry: 7 to 9"
    MsgBox ExtractFirstAndLast(2) ' this would return "Tom: 1 to 3 & 7 to 9
End Sub