如何在排序中包含边界

Question

问题：
有没有一种方法可以在MS Excel VBA中进行排序，其中单元格边界在排序时随值移动？

详细信息：

• 我在文档中没有看到任何指示如何做到这一点的内容。

• 我希望避免在单元格或代码中添加任何内容来指示其边界。我可以创建一个单独的方法，在排序后查看每个单元格，并将边界应用于正确的单元格，但我希望避免这种情况。换句话说，一旦设置了边界，它就需要在排序过程中随单元格的值移动。

• 我在Win7机器上使用Excel2007

代码/示例：
例如，以一个简单的过程为例：

Public Sub sort_test()
'declare key range and range to sort
Dim range_keyRange As Range
Dim range_fullRange As Range
'key range is column A, rows 1 through 5
Set range_keyRange = Range("A1:A5")
'full range is the used range of the active sheet
Set range_fullRange = ActiveSheet.UsedRange
'clear previous sortfields
ActiveSheet.Sort.SortFields.Clear
'set sortfields
ActiveSheet.Sort.SortFields.Add _
  Key:=range_keyRange, _
  SortOn:=xlSortOnValues, _
  Order:=xlAscending, _
  DataOption:=xlSortTextAsNumbers
'apply sort
With ActiveSheet.Sort
  .SetRange range_fullRange
  .Header = xlNo
  .MatchCase = False
  .Apply
End With
End Sub

我创建了下表，在包含"1"的单元格周围有一个边框。。。

2 b
4天
1 a
3 c
5e

当我排序时，结果是这样的，在包含"3"的单元格周围有一个边框：
1 a
2 b
3 c
4天
5e

边界保持不变。如何在排序过程中使边框与单元格一起"移动"？

我实际的排序过程更复杂，处理的数据比这里显示的要多。

Answer 1

如果你愿意，这将是一种"黑客"。。。(不是真的，但w/e(

您可以通过VBA宏和"Helper"列来实现这一点。

基本上，在排序之前添加额外的列，对于包含带边框单元格的每列添加1。(所以，如果10列中有3列有带边框的单元格，你会添加3列。我会将它们命名为"colBBorders"ColFborders"等。(

当辅助列的引用列有边框时，让宏在辅助列的每一行上加一个x。

例如，如果列A-F、列b和列d有带边框的单元格，比如说，第1,3,5行在b中有边框，第2,4,6行在d中有边框。在第一个辅助列(可能它的名称是"ColBBorders"(中，宏会在第一行1,3,5上放x，在第二个辅助列中(也许它的标题是ColDBorders(，宏会将x放在第2,4,6行上

然后，排序后，使用另一个宏，A(重新命名所有边界(也许手动操作更容易(，然后当辅助列(colbborders，colDBorders(的行上有x时，将边界放在相应引用列(b或D(中的每个单元格周围。

如果给helpers提供标准名称，则可以使用例如left(cells(1, 7).value, 4)。如果第7列的标题为"colbborders"，则该代码将获得字母"B"，您可以使用该字母来标识引用的列。

Answer 2

为了进行早期开发，几年前，我定制了一个"Quicksort"方法，以便对多列表进行快速排序。为了你的目的，我定制了这个程序的"置换"部分。它依赖于"复制"方法，因此在"大"多列表上不会很快。这段代码不符合第2点的某些部分，因为代码已经更改，但我希望您会发现多列的可能性很有用。

Option Explicit
Option Compare Text
Option Base 1
Dim iRowFirst As Long, iRowLast As Long
Dim iBas As Long, iHaut As Long, iRowMid As Long
Dim sVarMid As String
Public Sub sort_test()
    'declare table
    Dim MCTable() As Variant
    'declare key range and range to sort
    Dim range_keyRange As Range
    'key range is column A, rows 1 through 5
    Set range_keyRange = Range("A1:A5")
    ActiveWorkbook.Names.Add Name:="ToSort", RefersTo:="=" & range_keyRange.Address
    ' call "Temp" any cell not used
    ActiveWorkbook.Names.Add Name:="Temp", RefersTo:="=$C$1"
    MCTable() = Range("ToSort").Value
    Application.ScreenUpdating = False
    ' call QuickSort1(Table which contains the values, # of the column sort key, "asce" or "desc")
    Call QuickSort1(MCTable, 1, "desc")
    Application.ScreenUpdating = True
    Set range_keyRange = Nothing
End Sub
Public Sub QuickSort1(ByRef vList, iColK1 As Long, Sens As String, _
                      Optional ByVal pRowLeft As Long, Optional ByVal pRowRight As Long)
' iColK1 is the number of the column key for sorting.
    iBas = LBound(vList, 2): iHaut = UBound(vList, 2)
    If pRowRight = 0 Then
        pRowLeft = LBound(vList, 1)
        pRowRight = UBound(vList, 1)
    End If
    iRowFirst = pRowLeft
    iRowLast = pRowRight
    iRowMid = (pRowLeft + pRowRight)  2
    sVarMid = vList(iRowMid, iColK1)
    Do
'=====================================================================================
'   Comparaison
'=====================================================================================
        If LCase(Sens) Like "asce" Then
            Do While sVarMid > vList(iRowFirst, iColK1) And iRowFirst < pRowRight
                iRowFirst = iRowFirst + 1
            Loop
            Do While vList(iRowLast, iColK1) > sVarMid And iRowLast > pRowLeft
                iRowLast = iRowLast - 1
            Loop
        ElseIf LCase(Sens) Like "desc" Then
            Do While vList(iRowFirst, iColK1) > sVarMid And iRowFirst < pRowRight
                iRowFirst = iRowFirst + 1
            Loop
            Do While sVarMid > vList(iRowLast, iColK1) And iRowLast > pRowLeft
                iRowLast = iRowLast - 1
            Loop
        End If
'=====================================================================================
'       Permutation
'=====================================================================================
        If iRowFirst <= iRowLast Then
            ' Echange de positions
            Call MoveRow(vList, iRowFirst, iRowLast, iBas, iHaut)
            iRowFirst = iRowFirst + 1
            iRowLast = iRowLast - 1
        End If
'=====================================================================================
    Loop Until iRowFirst > iRowLast
    If pRowLeft < iRowLast Then QuickSort1 vList, iColK1, Sens, pRowLeft, iRowLast
    If iRowFirst < pRowRight Then QuickSort1 vList, iColK1, Sens, iRowFirst, pRowRight
End Sub
Sub MoveRow(ByRef aList, iSour As Long, iDest As Long, iBas As Long, iHaut As Long)
Dim Temp() As String
Dim rTem As Range
Dim i As Long
Dim bGo As Boolean
    For i = iBas To iHaut
        ReDim Preserve Temp(i)
        Range("ToSort")(iDest, i).Copy Range("Temp")
        Temp(i) = aList(iDest, i)
        Range("ToSort")(iSour, i).Copy Range("ToSort")(iDest, i)
        aList(iDest, i) = aList(iSour, i)
        Range("Temp").Copy Range("ToSort")(iSour, i)
        aList(iSour, i) = Temp(i)
    Next i
End Sub

希望能有所帮助。

Answer 3

对于10++列，辅助列效率不高。在现实世界中，并不是所有的动作都会变成一种算法。例如，两个单元格的值、格式等都是相同的，但其中一个单元格是支持接收的边界。我们可以使用VBA进行排序(而不是VBA中Excel默认的方法(。问题是VBA代码是如何设计的。