使用 LibreOffice Calc 中的自定义列表创建一个宏来对行进行排序
Make a macro to sort a row using a custom list in LibreOffice Calc
我需要对包含以下格式的单元格的列进行排序：“TITLE 文本”。我知道可能的标题列表，但不知道文本，所以我想做的是以非字母顺序的自定义顺序（例如：PLA、ARG、FHI、BRT）对标题进行排序。问题是标题和文本在同一个单元格中。
因此，例如，这是我可能想要处理的数据屏幕：
如果单元格与列表成员不完全匹配，我该如何排序？
而且，如果可能的话，如何使用宏而不是手动来做到这一点？
不是很难。我将尝试解释这是如何完成的。
首先，我们需要想办法将要排序的单元格范围传递给宏。有不同的方法——直接在宏代码中写入地址，将其作为参数传递给 UDF，从当前 selection 中获取。我们使用第三种方法 - 它不是最容易编码的，但它适用于任何数据集。
使用当前 selection 的主要困难在于 selection 可以是单个单元格（无需排序）、一系列单元格（并且可能是几列 - 如何对此进行排序？）或多个单元格范围（如果您按住 CTRL 键并 select 几个未连接的范围）。
一个好的宏应该能处理所有这些情况。但是现在我们不是在写一个好的宏，我们正在熟悉解决此类问题的原理（由于StackOfflow是程序员的资源，这里的答案是帮助您自己编写代码，而不是得到ready-made 程序免费 )。因此，我们将忽略单个单元格并
多个范围 - 我们将停止执行宏。而且，如果selected范围内不止一列，那我们也不会做任何事情。
此外，如果select编辑了整列，我们将要排序的范围限制在已用区域。这将对真实数据进行排序，但不会对百万个空单元格进行排序。
执行所有这些操作的代码如下所示：
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
程序最后一行提到的getSorted()函数必须以两个数组为参数——待排序单元格的值和排序列表 — 和 return 一个排序值数组。
这里应该提到处理来自单元格区域的数据的一个方面。如果在 Excel 中从范围接收数据后我们得到一个 two-dimensional 数组，那么在 OpenOffice/LibreOffice 中我们得到一个 one-dimensional “数组的数组”，其中的每个元素都是一个one-dimensional 一行的单元格值数组。写入范围是从完全相同的结构，从“数组的数组”中完成的。 getSorted()函数的第一个参数是oDataArray——就是这样一个数组的数组，这个在处理数据的时候会需要考虑到。
getSorted() 函数有什么作用？它将根据 oDataArray 值构建一个按 Headers 排序的“树”。事实上，这不是一棵树——它是所有 Headers 以及所有带有这些 Headers 的值的升序排列数组。值也是一个排序数组。然后该函数将从树中 select 列表中列出的那些标题并将它们从树中删除。如果在所有操作之后，一些元素仍然留在排序树中，它们将显示在最后。
该函数会将结果累加到一个与原始数组大小相同的单独数组中。换句话说，该算法将使用比原始排序范围多三倍的内存——源数据、树和结果数组。该函数会将结果累积到一个与原始数组大小相同的单独数组中。换句话说，该算法将使用比原始排序范围多三倍的内存——源数据、树和结果数组。
您可以尝试节省资源，将结果直接写入原始数组。但我强烈建议不要这样做。
事实上，一个数组单元格可能包含的不是一个值，而是一个值的引用，在编码不准确的情况下，你不会得到一个大的排序数组，而是一个具有相同值的大数组（最后一个单元格）。
我故意不对以下所有代码发表评论 - 如果您无需评论就可以阅读并理解这些代码，那么您将了解如何对操作进行编程以处理来自范围的数据：
Function getSorted(aData As Variant, aList As Variant) As Variant
Dim aRes As Variant
Dim i As Long, pos As Long, j As Long, k As Long, m As Long, uB As Long
Dim aTemp As Variant
aTemp = Array()
ReDim aRes(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
pos = InStr(aData(i)(0), " ")
If pos > 0 Then
AddToArray(Left(aData(i)(0),pos-1), aData(i)(0), aTemp)
Else
AddToArray(aData(i)(0), aData(i)(0), aTemp)
EndIf
Next i
m = LBound(aData) - 1
For i = LBound(aList) To UBound(aList)
k = getIndex(aList(i), aTemp)
If k > -1 Then
uB = UBound(aTemp) - 1
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
For j = k To uB
aTemp(j) = aTemp(j+1)
Next j
ReDim Preserve aTemp(uB)
EndIf
Next i
For k = LBound(aTemp) To UBound(aTemp)
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
Next k
getSorted = aRes
End Function
为了构建排序树，使用了两个子例程 - 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
getIndex() 函数 使用相同的二进制搜索。如果可以找到它，它将 return 数组中元素的索引，否则 -1：
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
这就是解决任务所需的全部内容：
带代码的演示文件 - SortByTitle.ods
我需要对包含以下格式的单元格的列进行排序：“TITLE 文本”。我知道可能的标题列表，但不知道文本，所以我想做的是以非字母顺序的自定义顺序（例如：PLA、ARG、FHI、BRT）对标题进行排序。问题是标题和文本在同一个单元格中。
因此，例如，这是我可能想要处理的数据屏幕：
如果单元格与列表成员不完全匹配，我该如何排序？ 而且，如果可能的话，如何使用宏而不是手动来做到这一点？
不是很难。我将尝试解释这是如何完成的。
首先，我们需要想办法将要排序的单元格范围传递给宏。有不同的方法——直接在宏代码中写入地址，将其作为参数传递给 UDF，从当前 selection 中获取。我们使用第三种方法 - 它不是最容易编码的，但它适用于任何数据集。
使用当前 selection 的主要困难在于 selection 可以是单个单元格（无需排序）、一系列单元格（并且可能是几列 - 如何对此进行排序？）或多个单元格范围（如果您按住 CTRL 键并 select 几个未连接的范围）。
一个好的宏应该能处理所有这些情况。但是现在我们不是在写一个好的宏，我们正在熟悉解决此类问题的原理（由于StackOfflow是程序员的资源，这里的答案是帮助您自己编写代码，而不是得到ready-made 程序免费 )。因此，我们将忽略单个单元格并 多个范围 - 我们将停止执行宏。而且，如果selected范围内不止一列，那我们也不会做任何事情。
此外，如果select编辑了整列，我们将要排序的范围限制在已用区域。这将对真实数据进行排序，但不会对百万个空单元格进行排序。
执行所有这些操作的代码如下所示：
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
程序最后一行提到的getSorted()函数必须以两个数组为参数——待排序单元格的值和排序列表 — 和 return 一个排序值数组。
这里应该提到处理来自单元格区域的数据的一个方面。如果在 Excel 中从范围接收数据后我们得到一个 two-dimensional 数组，那么在 OpenOffice/LibreOffice 中我们得到一个 one-dimensional “数组的数组”，其中的每个元素都是一个one-dimensional 一行的单元格值数组。写入范围是从完全相同的结构，从“数组的数组”中完成的。 getSorted()函数的第一个参数是oDataArray——就是这样一个数组的数组，这个在处理数据的时候会需要考虑到。
getSorted() 函数有什么作用？它将根据 oDataArray 值构建一个按 Headers 排序的“树”。事实上，这不是一棵树——它是所有 Headers 以及所有带有这些 Headers 的值的升序排列数组。值也是一个排序数组。然后该函数将从树中 select 列表中列出的那些标题并将它们从树中删除。如果在所有操作之后，一些元素仍然留在排序树中，它们将显示在最后。
该函数会将结果累加到一个与原始数组大小相同的单独数组中。换句话说，该算法将使用比原始排序范围多三倍的内存——源数据、树和结果数组。该函数会将结果累积到一个与原始数组大小相同的单独数组中。换句话说，该算法将使用比原始排序范围多三倍的内存——源数据、树和结果数组。
您可以尝试节省资源，将结果直接写入原始数组。但我强烈建议不要这样做。
事实上，一个数组单元格可能包含的不是一个值，而是一个值的引用，在编码不准确的情况下，你不会得到一个大的排序数组，而是一个具有相同值的大数组（最后一个单元格）。
我故意不对以下所有代码发表评论 - 如果您无需评论就可以阅读并理解这些代码，那么您将了解如何对操作进行编程以处理来自范围的数据：
Function getSorted(aData As Variant, aList As Variant) As Variant
Dim aRes As Variant
Dim i As Long, pos As Long, j As Long, k As Long, m As Long, uB As Long
Dim aTemp As Variant
aTemp = Array()
ReDim aRes(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
pos = InStr(aData(i)(0), " ")
If pos > 0 Then
AddToArray(Left(aData(i)(0),pos-1), aData(i)(0), aTemp)
Else
AddToArray(aData(i)(0), aData(i)(0), aTemp)
EndIf
Next i
m = LBound(aData) - 1
For i = LBound(aList) To UBound(aList)
k = getIndex(aList(i), aTemp)
If k > -1 Then
uB = UBound(aTemp) - 1
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
For j = k To uB
aTemp(j) = aTemp(j+1)
Next j
ReDim Preserve aTemp(uB)
EndIf
Next i
For k = LBound(aTemp) To UBound(aTemp)
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
Next k
getSorted = aRes
End Function
为了构建排序树，使用了两个子例程 - 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
getIndex() 函数 使用相同的二进制搜索。如果可以找到它，它将 return 数组中元素的索引，否则 -1：
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
这就是解决任务所需的全部内容：
带代码的演示文件 - SortByTitle.ods