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 

希望它有幫助。