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
1 a 3 c
5 e

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

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

我的实际排序过程比较复杂，处理的数据比此处显示的要多，但我用这个例子来表达观点。

Answer 1

如果你愿意，那将是一种“黑客”......（不是真的，但是没有）

您可以使用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）宏将把x放在行2,4,6上

然后，在排序之后，有另一个宏A）重新划分所有边界（可能更容易手动完成），然后在其辅助列（colbborders，colDBorders）的相应参考列（b或D）中的每个单元格周围放置边框）在该行上有一个x。

如果你给帮助者标准名称，你可以使用例如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代码。

Excel VBA排序包括边框

3 个答案: