Excel VBA排序包括边界

Question

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

详情：

• 我已经通过sort object members和sortfield object members看去，可惜看不到文档中任何可能指示如何做到这一点。
• 我想避免必须附加任何东西到单元格或代码，以指示它的边界应该是什么。我可以创建一个单独的方法，在排序后查看每个单元格，并将边框应用于正确的单元格，但我想避免这种情况。换句话说，一旦设置了边框，它就需要在分类过程中随着单元格的值移动。
• 我在Win7机器上使用Excel 2007。

代码/实施例：
例如，采取简单的程序：

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 d
3c中
5e中

...当我排序，结果是这样的，与所述细胞周围的边框含有 “3”：
2 B
3c中
4 d
5e中

请注意，尽管排序成功，边界仍处于相同的位置。在排序过程中，如何让边界与单元格“移动”？

我实际的排序过程比较复杂，处理的数据比这里显示的要多，但我用这个例子来说明问题。

Answer 1

这将是一个样的，如果你将“黑客” ......（不是真的，但W/E）

你可以用VBA宏和“助手”栏目做到这一点。

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

有一个宏在每行放置一个x当它的引用列有辅助列时有一个边框。

因此，例如，如果您的列A-F的列b和d的单元格带有边框，并且可以说，行1,3,5在B中具有边界，行2,4,6在D中具有边界。在第一个帮助器列（也许它的名字是“ColBBorders”）中，宏会将x放在行1,3,5上，并放在第二个帮助器列中（也许它的标题是ColDBorders），宏将放置在行2,4上， 6

然后，在排序后，有另一个宏，它可以让所有的边界都可以完成（也许手动更容易），然后在每个单元格的辅助列（b或D） ，colDBorders）在该行上有一个x。

如果您提供助手标准名称，例如，如果第7列的标题为“colbborders”，则可以使用left(cells(1, 7).value, 4)，然后该代码会为您提供字母“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 

希望它有帮助。