Как отсортировать столбцы по тексту?Возникли проблемы с текущим кодом - PullRequest
0 голосов
/ 10 мая 2019

У меня есть отчет, мне нужно сгруппировать аналогичные значения, отсортированные по указанному столбцу, и снова заполнить список.

Private Sub CommandButton1_Click()
Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String

'select range based on given named range
Set myRange = Range("D2:D1000")
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 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 firstBlankRow <> 0 Then
            'if firstBlankRow is assigned and this row has a value
            '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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...