Sorting 使用LibreOffice Calc中的自定义列表生成宏以对行进行排序

我需要对包含以下格式单元格的列进行排序：“标题文本”。我知道可能的标题列表，但不知道文本，所以我想做的是按照自定义顺序（例如：PLA、ARG、FHI、BRT）对标题进行排序，而不是按字母顺序。问题是标题和文本在同一单元格中。 例如，这里有一个我可能想处理的数据屏幕：

如果单元格与列表成员不完全匹配，如何对其进行排序？

---

如果可能的话，如何使用宏而不是手动执行此操作？

这不是很难。我将试图解释这是如何做到的

首先，我们需要找到一种方法，将要排序的单元格范围转移到宏中。有不同的方法-直接在宏代码中写入地址，将其作为参数传递给UDF，从当前选择中获取地址。我们使用第三种方法——这不是最容易编码的方法，但它可以用于任何数据集

使用当前选择的主要困难在于，选择可以是一个单元格（无需排序）、一个单元格区域（可能是多个列-如何排序？）或多个单元格区域（如果按住CTRL键并选择多个未连接的区域）

一个好的宏应该处理每一种情况。但是现在我们并没有编写一个好的宏，我们正在逐渐了解解决这些问题的原理（因为StackOffflow是程序员的资源，这里的答案帮助您自己编写代码，而不是免费获得现成的程序）。因此，我们将忽略单个单元格并 多个范围-我们将停止宏的执行。此外，如果所选范围中有多个列，则我们也不会执行任何操作

此外，如果选择了完整列，我们将要排序的范围限制为已使用的区域。这将对真实数据进行排序，但不会对一百万个空单元格进行排序

执行所有这些操作的代码如下所示：

Sub SortByTitles()
Dim oCurrentSelection As Variant
Dim oSortRange As Variant
Dim oSheet As Variant
Dim oCursor As Variant
Dim oDataArray As Variant
Dim sList As String 
    sList = "PLA,ARG,FHI,BRT"
    oCurrentSelection = ThisComponent.getCurrentSelection()
Rem Is it one singl cell?
    If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCell") Then Exit Sub 
Rem Is it several ranges of cells?
    If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then Exit Sub 
Rem Is this one range of cells? (It can be a graphic item or a control. 
Rem Or it may not even be a Calc spreadsheet at all)
    If Not oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub 
Rem Is there only one column selected?
    If oCurrentSelection.getColumns().getCount() <> 1 Then Exit Sub 
Rem Is the current selection outside of the used area?  
    oSheet = oCurrentSelection.getSpreadsheet()
    oCursor = oSheet.createCursor()
    oCursor.gotoEndOfUsedArea(True)
    oSortRange = oCursor.queryIntersection(oCurrentSelection.getRangeAddress())
    If oSortRange.getCount() <> 1 Then Exit Sub 
Rem Redim oSortRange as single range (not any ranges)
    oSortRange = oSortRange.getByIndex(0)
Rem Get data from oSortRange
    oDataArray = oSortRange.getDataArray()
Rem Paste sorted data to the same place:
    oSortRange.setDataArray(getSorted(oDataArray, Split(sList,",")))
End Sub

要构建排序树，需要使用两个子例程-AddToArray（）和InsertToArray（）。它们非常相似，前八行是一个普通的二进制搜索，剩下的10-12行是当数组中没有找到元素时发现的，当数组中没有找到元素时：

Sub AddToArray(key As Variant, value As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
    l=LBound(aData)
    r=UBound(aData)+1
    N=r
    While (l<r)
        m=l+Int((r-l)/2)
        If aData(m)(0)<key Then 
            l=m+1
        Else
            r=m
        EndIf
    Wend
    If r=N Then
        ReDim Preserve aData(0 To N)
        aData(N) = Array(key, Array(value))
    ElseIf  aData(r)(0)=key Then
        InsertToArray(value, aData(r)(1))
    Else
        ReDim Preserve aData(0 To N)
        For i = N-1 To r Step -1
            aData(i+1)=aData(i)
        Next i
        aData(r) = Array(key, Array(value))
    EndIf
End Sub

Sub InsertToArray(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
    l=LBound(aData)
    r=UBound(aData)+1
    N=r
    While (l<r)
        m=l+Int((r-l)/2)
        If aData(m)<key Then 
            l=m+1
        Else
            r=m
        EndIf
    Wend
    If r=N Then
        ReDim Preserve aData(0 To N)
        aData(N) = key
    Else
        ReDim Preserve aData(0 To N)
        For i = N-1 To r Step -1
            aData(i+1)=aData(i)
        Next i
        aData(r) = key
    EndIf
End Sub

Sub AddToArray（键作为变量，值作为变量，数据作为变量）
尺寸l&，r&，m&，N&，i&
l=磅（aData）
r=UBound（aData）+1
N=r
而
Sub AddToArray(key As Variant, value As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
    l=LBound(aData)
    r=UBound(aData)+1
    N=r
    While (l<r)
        m=l+Int((r-l)/2)
        If aData(m)(0)<key Then 
            l=m+1
        Else
            r=m
        EndIf
    Wend
    If r=N Then
        ReDim Preserve aData(0 To N)
        aData(N) = Array(key, Array(value))
    ElseIf  aData(r)(0)=key Then
        InsertToArray(value, aData(r)(1))
    Else
        ReDim Preserve aData(0 To N)
        For i = N-1 To r Step -1
            aData(i+1)=aData(i)
        Next i
        aData(r) = Array(key, Array(value))
    EndIf
End Sub

Sub InsertToArray(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
    l=LBound(aData)
    r=UBound(aData)+1
    N=r
    While (l<r)
        m=l+Int((r-l)/2)
        If aData(m)<key Then 
            l=m+1
        Else
            r=m
        EndIf
    Wend
    If r=N Then
        ReDim Preserve aData(0 To N)
        aData(N) = key
    Else
        ReDim Preserve aData(0 To N)
        For i = N-1 To r Step -1
            aData(i+1)=aData(i)
        Next i
        aData(r) = key
    EndIf
End Sub

Function getIndex(key As Variant, aData As Variant) As Long
Dim l&, r&, m&, N&
    l=LBound(aData)
    r=UBound(aData)+1
    N=r
    While (l<r)
        m=l+Int((r-l)/2)
        If aData(m)(0)<key Then 
            l=m+1
        Else
            r=m
        EndIf
    Wend
    If r=N Then
        getIndex = -1
    ElseIf  aData(r)(0)=key Then
        getIndex = r
    Else
        getIndex = -1
    EndIf
End Function