#1
|
|||
|
|||
How to personalize sort criteria
I want to sort paragraphs ordered by paragraph length. There is any way to do it?
I checked the function Selection.Sort, but it only accepts a parameter named SortFieldType, which only accepts values from an pre fixed enum named WdSortFieldType |
#2
|
||||
|
||||
You would need to calculate the length of each paragraph before sorting. The simplest way to do the would be to add all the paragraphs to a table, insert an empty column in the table, calculate each paragraph's length and write it to the empty cell on that row, sort the table by the column you added, then optionally, delete that column and convert the table back to text.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Just the sorting part is easy. The trouble is maintaining any direct formatting in the rearranged paragraphs. Crude but this may do.
Code:
Option Explicit Sub Demo() Dim arrTextToSort() As String Dim lngIndex As Long Dim oRng As Range, oRngTemp As Range Dim oCol As New Collection Dim oPar As Paragraph Dim oDoc As Document If Selection.Characters.last = vbCr Then Selection.End = Selection.End - 1 arrTextToSort = Split(Selection.Range.Text, vbCr) QuickSortOnLength arrTextToSort, LBound(arrTextToSort), UBound(arrTextToSort) Set oRng = Selection.Range For lngIndex = LBound(arrTextToSort) To UBound(arrTextToSort) For Each oPar In Selection.Paragraphs If Left(oPar.Range.Text, Len(oPar.Range.Text) - 1) = arrTextToSort(lngIndex) Then oCol.Add oPar.Range.FormattedText Exit For End If Next Next Set oDoc = Documents.Add Set oRngTemp = oDoc.Range For lngIndex = 1 To oCol.Count oCol.Item(lngIndex).Copy oRngTemp.Paste oRngTemp.Collapse wdCollapseEnd Next Set oRngTemp = oDoc.Range oRngTemp.End = oRngTemp.End - 1 oRngTemp.Copy oRng.Paste oDoc.Close wdDoNotSaveChanges lbl_Exit: Set oDoc = Nothing Exit Sub End Sub Public Sub QuickSortOnLength(arrInputList() As String, lngLB As Long, lngUB As Long) Dim strPivot As String, strTemp As String Dim lngFirst As Long, lngLast As Long lngFirst = lngLB lngLast = lngUB On Error GoTo lbl_Exit strPivot = arrInputList(lngLB + lngUB \ 2) Do While lngFirst <= lngLast Do While lngFirst < lngUB And SortCompare(arrInputList(lngFirst), strPivot) lngFirst = lngFirst + 1 Loop Do While lngLast > lngLB And SortCompare(strPivot, arrInputList(lngLast)) lngLast = lngLast - 1 Loop If lngFirst <= lngLast Then strTemp = arrInputList(lngFirst) arrInputList(lngFirst) = arrInputList(lngLast) arrInputList(lngLast) = strTemp lngFirst = lngFirst + 1 lngLast = lngLast - 1 End If Loop If (lngLB < lngLast) Then QuickSortOnLength arrInputList, lngLB, lngLast If (lngFirst < lngUB) Then QuickSortOnLength arrInputList, lngFirst, lngUB lbl_Exit: Exit Sub End Sub Private Function SortCompare(strA As String, strB As String) As Boolean Select Case True Case Len(strA) < Len(strB): SortCompare = True Case Len(strA) > Len(strB): SortCompare = False Case Len(strA) = Len(strB): SortCompare = LCase$(strA) < LCase$(strB) End Select End Function |
#4
|
|||
|
|||
Quote:
Quote:
You did a complete coding of a quicksort algorithm. That's jawbreaking. You put a lot of work. What an amazing person you are. |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Create a unique list of values that match a criteria, sorted in order of another criteria | BradRichardson | Excel | 2 | 01-03-2017 12:25 AM |
Personalize windows explorer | dianabanana | Office | 1 | 03-24-2014 08:10 PM |
Personalize a PP Presentation for different users? | dextrousdave | PowerPoint | 0 | 02-26-2012 11:49 AM |
Forgotten Sort and Filter Criteria | rbdmg | Mail Merge | 0 | 10-31-2011 09:14 PM |
Sort by criteria: number of results | p0k | Excel | 1 | 10-22-2009 08:33 PM |