用于分组行的宏

时间:2017-11-07 10:45:35

标签: excel vba excel-vba

我目前有一个宏,它将空白单元格组合在一起并忽略其中有值的单元格,我无法弄清楚如何更改它以便它使用特定值进行分组(150,155,130,115和110)确切地说。)

我的问题是如何更改代码,以便它不是对空白单元格进行分组,而是将单元格中的值组合在一起。

所以我想要这个

看起来像这样

澄清宏的作用:

它遍历每个单元格并检查值。如果它有价值,那么它会跳到下一个单元格。如果单元格没有值,则检查下一个单元格,如果发生相同的情况,则将这些单元格组合在一起。

代码:

Public Sub GroupCells() 
    Dim myRange As Range
    Dim rowCount As Integer, currentRow As Integer
    Dim firstBlankRow As Integer, lastBlankRow As Integer
    Dim currentRowValue As String
    Dim neighborColumnValue As String

    Rows("1:2000").RowHeight = 15
    Columns("A:N").ColumnWidth = 13

    'select range based on given named range
    Set myRange = Range("A7:A2000")
    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

        If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
            If firstBlankRow = 0 Then
                firstBlankRow = currentRow
            End If
        ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
            If firstBlankRow = 0 Then
                firstBlankRow = currentRow
            ElseIf firstBlankRow <> 0 Then
                lastBlankRow = currentRow - 1
            End If
        End If


        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

1 个答案:

答案 0 :(得分:1)

这应该这样做。您可以修改它以适应更详细的条件等:

Option Explicit
Sub Macro1()
    Dim bBreak As Boolean
    Dim i As Long
    Dim lRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim WS As Worksheet
    Dim dict As Object

    Set WS = ActiveSheet

    'I assume the values are in column A
    With WS
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    'Define a dictionary to store values that should be grouped
    Set dict = CreateObject("scripting.dictionary")

    dict.Add 150, ""
    dict.Add 155, ""
    dict.Add 130, ""
    dict.Add 115, ""
    dict.Add 110, ""

    'Loop through the values in Column A and group them
    For i = 1 To lRow
        Set cell = WS.Cells(i, 1)
        If dict.exists(cell.Value) Then 'cell value is among values store in the dict, so it should be grouped
            If rng Is Nothing Then
                Set rng = cell 'first cell with a value to be grouped
            Else
                Set rng = Application.Union(rng, cell)
            End If
        Else 'cell is a breaker value
            If rng Is Nothing Then 'there is nothing to be grouped, continue
                'do nothing
            Else 'this is the last cell of a range that should be grouped
                rng.Rows.Group 'group only rows
                Set rng = Nothing 'reset the range
            End If
        End If
    Next i

    'If the last cell is not a breaker, the last cells will not be grouped
    If Not rng Is Nothing Then
        rng.Rows.Group 'group only rows
    End If


End Sub