Пользовательская сортировка определенных значений ячеек в нижней части диапазона - PullRequest
0 голосов
/ 04 мая 2019

У меня есть общая рабочая книга, которая постоянно обновляется несколькими пользователями в течение дня.Рабочая тетрадь используется как график активных ремонтных работ в нескольких ремонтных мастерских моей компании.Когда задание помечено как «выполнено», его необходимо отсортировать по нижней части списка, чтобы можно было просматривать только активные данные и не загромождать «выполненные» задания.Проблема в том, что «done» начинается с «d», что в алфавите раньше, чем имена техников, выполняющих работу.

У меня есть сортировка по убыванию не будет работать, так как есть пробелы и перечисленные элементы, которыеупасть в алфавитном порядке с обеих сторон "готово".

Я пытался поместить "z" перед "готово", и хотя это на самом деле работает, я стараюсь сохранить его как можно более чистым.Я бы предпочел не делать этого.Я также думал о добавлении дополнительного столбца, который проверяет перечисленные элементы, но есть 2 предостережения.1 - я на самом деле пытаюсь изучить VBA и 2 - я бы хотел сохранить размер файла как можно меньше.

Когда моя работа помечена как «выполненная», мне нужно ее отсортировать (как событие изменения рабочего листа) в конец.Как мне это сделать?

Ниже приведен пример того, с чего я начал.Кроме того, вот пример данных, с которыми я работаю.Список ниже всех появляется в том же столбце.Это очень важно для работы книги, потому что «выполнено» означает, что техник больше не работает над проектом и, таким образом, оно «выполнено».Для анонимности я сохранил названия вымыслов, но принцип тот же.Имена в алфавитном порядке сортируются по обеим сторонам слова «сделано».Мне нужно отсортировать по алфавиту, но держать «готово» в конце списка.

Джон Смит

Алекс Смит

Брэндон Смит

НатанСмит

Готово

With ActiveSheet.Sort
     .SortFields.Add Key:=Range("B3"), Order:=xlAscending '<-- I don't want to sort assending!!
     .SetRange Range("A3:S" & Cells(Rows.Count, 2).End(xlUp).Row)
     .Header = xlYes
     .Apply
End With

1 Ответ

0 голосов
/ 04 мая 2019

Если исходное значение базовой ячейки не важно, то есть несколько способов, которыми вы можете показать пользователю done в ячейке, в то время как фактическое значение ячейки равно zdone .Первым на ум приходит условное форматирование.

Альтернативно, временный столбец 'помощника' может быть вставлен, заполнен, использован в качестве первичного ключа для сортировки, а затем удален, прежде чем управление будет возвращено пользователю.

Массив данных может быть собран, а затем пользовательским образом отсортирован в памяти в соответствии с любыми условиями, которые вы кодируете перед возвратом отсортированных данных обратно на лист.

Кстати, неясно, каксортировка по zdone работает должным образом, если задействованы пустые ячейки.Пустые ячейки должны быть помещены ниже zdone в порядке возрастания, чтобы ваши строки zdone не находились внизу списка.

Вот основанный на массиверешение, позволяющее создать любой пользовательский алгоритм сортировки, который вы можете себе представить.

Option Explicit

Sub CustomDoneArraySort()

    Dim i As Long, j As Long, k As Long, arr As Variant, tmp As Variant

    With Worksheets("sheet4")

        'collect data from worksheet excluding header
        arr = .Range(.Cells(4, "A"), .Cells(.Rows.Count, "C").End(xlUp)).Value

        'expand array to allow a 'helper column' in the second rank
        ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _
                           LBound(arr, 2) To UBound(arr, 2) + 1)

        'populate helper column
        'this can be as complicated as you want but it
        'will ultimately determine the finished sort order
        'this version will create a column where blanks are 'zz'
        'and 'done' is 'zzz' and other text is unchanged
        For i = LBound(arr, 1) To UBound(arr, 1)

            Select Case arr(i, 2)
              Case "done", "Done", "DONE"
                arr(i, UBound(arr, 2)) = "zzz"
              Case vbNullString
                arr(i, UBound(arr, 2)) = "zz"
              Case Else
                arr(i, UBound(arr, 2)) = arr(i, 2)
            End Select

        Next i

        'create a temporary array to use for shifting values
        ReDim tmp(LBound(arr, 2) To UBound(arr, 2))

        'sort on the 'helper column'
        For i = LBound(arr, 1) To UBound(arr, 1) - 1
            For j = i To UBound(arr, 1)
                'xlAscending sort
                If arr(i, UBound(arr, 2)) > arr(j, UBound(arr, 2)) Then
                    'store the values from the sorting shift target in tmp
                    For k = LBound(tmp) To UBound(tmp)
                        tmp(k) = arr(j, k)
                    Next k
                    'transfer the values from the sorting shift source to the sorting shift target
                    For k = LBound(tmp) To UBound(tmp)
                        arr(j, k) = arr(i, k)
                    Next k
                    'put the tmp values in the sorting shift source
                    For k = LBound(tmp) To UBound(tmp)
                        arr(i, k) = tmp(k)
                    Next k
                End If
            Next j
        Next i

        'remove the array's 'helper column' in the second rank
        ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), _
                           LBound(arr, 2) To UBound(arr, 2) - 1)

        'return sorted array to worksheet
        .Cells(4, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

    End With
End Sub 

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...