這是一個棘手的問題，我什至無法嘗試使用 VBA 代碼來嘗試解決這個問題。使用 Table.Sort 沒有幫助。如果您對我的要求感到困惑，下面是一個示例：
BEFORE AFTER
rice rice
pea rice
apple pea
vegetable pea
vegetable apple
pea apple
apple vegetable
rice vegetable
orange orange
如上所示，雖然第二列中的資料按順序排列，但不是按字母順序排列的。是否可以做到這一點而不必將數字放在表格列中的文本前面然后排序？或者無需我手動完成所有操作？我上面的示例是一個簡單的示例，對于大量資訊，手動執行此操作是不切實際的。我可以使用公式在 EXCEL 中完成我需要的操作，但我確實需要 WORD 而不是 EXCEL 的文字處理能力。
uj5u.com熱心網友回復：
要使此代碼正常作業，您需要此參考。
這是從 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:\Path\To\Workbook\With\YourTable.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
uj5u.com熱心網友回復：
我有一些空閑時間，所以我根據我對您的排序規則的理解，在 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，確保多余的空白不會阻止匹配。
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/323888.html