获取列表中连续数据的多个实例的第一行和最后一行 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 到 3 & 7 到 9
- 迪克:5 到 8
- 哈利: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
我在 Excel 中有一个年历,大致如下:
-- 汤姆 -- 迪克 -- 哈利
1 -- x ----------------
2 -- x ----------------
3 -- x ----------------
4 ------x------------
5 ------x------------
6 --------x------------
7 x----------------x
8 x-----------------x
9 x-----------------x
我的数据由空白单元格组成,后面是连续条目组。
我想提取并显示与每组条目关联的第一个和最后一个日期。所以理想情况下函数的输出应该是:
- 汤姆:1 到 3 & 7 到 9
- 迪克:5 到 8
- 哈利: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