Question

我有一个共享的工作簿，多个用户在一天内不断更新。该工作簿在我公司的多个维修设施中用作实时维修工作的实时时间表。当作业被标记为“完成”时，需要将其排序到列表的底部，以便只能查看活动数据，而不会被“完成”的作业弄得混乱。问题是“完成”以“ d”开头，字母“ d”早于执行工作的技术人员姓名。

我排序降序将不起作用，因为空白和列出的项目按字母顺序落在“完成”的两边。

我尝试在“完成”的前面放置一个“ z”，尽管这确实可行，但我正在努力保持其尽可能整洁。我宁愿不这样做。我还考虑过添加一个额外的列来验证列出的项目，但是有两个警告。 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

Answer 1

如果基础单元格的原始值不重要，则可以通过几种方法在单元格的实际值为 zdone done 。 >。首先想到条件格式。

或者，可以插入，填充临时的“帮助程序”列，将其用作排序的主键，然后在将控制权传递回用户之前将其删除。

可以收集数据数组，然后根据您编写的任何条件在内存中自定义排序，然后将排序后的数据返回工作表。

顺便说一句，尚不清楚在涉及空白单元格的情况下 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

自定义将特定单元格的值排序到范围的底部

1 个答案: