是否有可能在Microsoft WORD表中对行进行排序，而不按字母顺序、字母数字顺序或日期顺序对数据进行排序?<

Question

这是一个棘手的问题，我甚至无法尝试使用VBA代码来尝试解决这个问题。用表。排序没有帮助。如果你对我的要求感到困惑，下面是一个例子:

BEFORE            AFTER
rice              rice
pea               rice
apple             pea
vegetable         pea
vegetable         apple
pea               apple
apple             vegetable
rice              vegetable
orange            orange

如上所述，尽管第二列中的数据按顺序排序，但它不是按字母顺序排序的。是否有可能做到这一点，而不必把数字放在前面的文本在一个表的列然后排序?或者不用我手动操作?我上面的例子很简单，对于大量的信息，手动执行这个操作是不实际的。我可以在EXCEL中使用公式做我需要的事情，但我真正需要的是word的文字处理能力，而不是EXCEL。

Answer 1

要使此代码工作，您需要此引用。
这是在Word VBA中运行的，而不是Excel。

Sub SortingSortOf()
Dim XL As Excel.Application, WB As Excel.Workbook
Dim WS As Excel.Worksheet, MatchCol As Excel.Range, Tbl As Table
Set XL = Excel.Application
Set WB = XL.Workbooks.Open("C:PathToWorkbookWithYourTable.xlsm") ' or.xlsx
Set WS = WB.Sheets("NameOfTableSheet")

' places a sort value one column to the right of the current data
Set MatchCol = WS.UsedRange.Columns(WS.Cells.SpecialCells(xlCellTypeLastCell).Column + 1)

' change this to whatever column holds your sort value
MatchCol.Formula = "=Match(A1, A:A, 0)"

' i'm assuming you have some sort of header
WS.UsedRange.Sort Key1:=MatchCol, Header:=xlYes

'optional, unless you want the sort number displayed in the table
MatchCol.Delete

' or wherever you want. doesn't have to be paragraph 1
If ActiveDocument.Paragraphs(1).Range.Tables.Count > 0 Then
' for some reason it doesn't overwrite an existing table
' so this will delete it first (even if there is more than one)
For Each Tbl In ActiveDocument.Paragraphs(1).Range.Tables
Tbl.Delete
Next Tbl
End If
WS.UsedRange.Copy
ActiveDocument.Paragraphs(1).Range.Paste

' putting false on close should prevent the save changes dialog,
' but there seems to be an excel bug, so shutting off alerts
XL.DisplayAlerts = False
WB.Close , False
XL.DisplayAlerts = True
End Sub

Answer 2

我有一些空闲时间，所以根据我对你排序规则的理解，我在Word中编写了一个排序表的程序。

Sub Example()
Call CustomSort(ThisDocument.Tables(1))
End Sub
Sub CustomSort(sortTable As Table)
'Create an array that contains the table values
Dim Items() As String
ReDim Items(1 To sortTable.Rows.Count, 1 To sortTable.Columns.Count)

Dim i As Long, j As Long
For i = 1 To sortTable.Rows.Count
For j = 1 To sortTable.Columns.Count
Items(i, j) = Left(sortTable.Cell(i, j).Range.Text, Len(sortTable.Cell(i, j).Range.Text) - 2) 
'removes the extra characters at the end of a cell - credit to Timothy Rylatt
Next j
Next i
'Sort the table
Dim r As Long
For i = 1 To UBound(Items, 1) - 2
For r = i + 2 To UBound(Items, 1)
If Items(i, 1) = Items(r, 1) Then Call ArrayRowShift(Items, r, i + 1)
Next r
Next i

'Output the table
For i = 1 To sortTable.Rows.Count
For j = 1 To sortTable.Columns.Count
sortTable.Cell(i, j).Range.Text = Items(i, j)
Next j
Next i
End Sub
Sub ArrayRowShift(ByRef Arr As Variant, RowIndex As Long, MoveTo As Long)
'For 2D arrays, takes an array row, moves it to the specified index, returns the shifted array
If RowIndex = MoveTo Then Exit Sub
Dim tmpRow() As Variant
ReDim tmpRow(LBound(Arr, 2) To UBound(Arr, 2))
For j = LBound(Arr, 2) To UBound(Arr, 2)
tmpRow(j) = Arr(RowIndex, j)
Next j
If RowIndex < MoveTo Then
For i = RowIndex + 1 To MoveTo
For j = LBound(Arr, 2) To UBound(Arr, 2)
Arr(i - 1, j) = Arr(i, j)
Next j
Next i
Else
For i = RowIndex To MoveTo + 1 Step -1
For j = LBound(Arr, 2) To UBound(Arr, 2)
Arr(i, j) = Arr(i - 1, j)
Next j
Next i
End If
For j = LBound(Arr, 2) To UBound(Arr, 2)
Arr(MoveTo, j) = tmpRow(j)
Next j
End Sub

我将表文本放入数组中，使用VBA重新排列数组中的内容，然后将其粘贴回表中。它适用于word中任何大小的表(1D或2D)。

如果要调整排序规则，需要编辑的行是If Items(i, 1) = Items(r, 1) Then。您可能希望在两者周围添加LCase，以消除大小写敏感性。或Trim，以确保多余的空白不会阻止匹配。