分组和编号由空行分隔的行

时间:2018-03-29 17:14:16

标签: excel excel-vba vba

我希望能够帮助自动化一个耗费大量时间的流程。基本上我有一个报告,其中相关行组由空行分隔。我想有办法用公式或宏来识别或为每个组分配一个数字。最终目标是为每个单独的组提供一笔金额。基本上没有其他方法来区分每个组中的内容,除了它们被空行隔开的事实。谢谢!

1 个答案:

答案 0 :(得分:0)

我会尝试这样的事情

Public Sub GroupCells()     昏暗myRange作为范围     Dim rowCount As Integer,currentRow As Integer     Dim firstBlankRow As Integer,lastBlankRow As Integer     Dim currentRowValue As String     Dim neighborColumnValue As String

'select range based on given named range
Set myRange = Range("rngList")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

firstBlankRow = 0
lastBlankRow = 0
'for every row in the range
For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, myRange.Column).Value
    neighborColumnValue = Cells(currentRow, myRange.Column - 1).Value

    If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        'if cell is blank and firstBlankRow hasn't been assigned yet
        If firstBlankRow = 0 Then
            firstBlankRow = currentRow
        End If
    ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        'if the cell is not blank and its neighbor's (to the left) value is 0,
        'and firstBlankRow hasn't been assigned, then this is the firstBlankRow
        'to consider for grouping
        If neighborColumnValue = 0 And firstBlankRow = 0 Then
            firstBlankRow = currentRow
        ElseIf neighborColumnValue <> 0 And firstBlankRow <> 0 Then
            'if firstBlankRow is assigned and this row has a value with a neighbor
            'who isn't 0, then the cell one row above this one is to be considered
            'the lastBlankRow to include in the grouping
            lastBlankRow = currentRow - 1
        End If
    End If

    'if first AND last blank rows have been assigned, then create a group
    'then reset the first/lastBlankRow values to 0 and begin searching for next
    'grouping
    If firstBlankRow <> 0 And lastBlankRow <> 0 Then
        Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
        Selection.Group
        firstBlankRow = 0
        lastBlankRow = 0
    End If
Next

End Sub