VBA，从父项生成path，子项目与自定义sorting关系

我正在使用此解决scheme来生成从父母和身份证关系的path

如何在Excel中build立父子数据表？

在我的情况下，sorting应该基于现有的字段（seq_num），自定义sorting级别1，自定义sorting级别2 ……自定义sorting级别max

input

id Parent_id seq_num

29938 29937 901

29939 29938 0

29940 29938 5

29941 29938 6

29942 29938 8

29943 29938 14

29944 29938 13

29945 29938 9

29946 29938 12

29947 29938 1

29948 29938 10

29949 29938 3

29950 29944 512

29951 29944 513

29952 29943 512

29953 29943 513

产量

订单IDpath

1 29938 29937.29938

2 29939 29937.29938.29939

3 29947 29937.29938.29947

4 29949 29937.29938.29949

5 29940 29937.29938.29940

6 29941 29937.29938.29941

7 29942 29937.29938.29942

8 29945 29937.29938.29945

9 29948 29937.29938.29948

10 29946 29937.29938.29946

11 29944 29937.29938.29944

12 29950 29937.29938.29944.29950

13 29951 29937.29938.29944.29951

14 29943 29937.29938.29943

15 29952 29937.29938.29943.29952

16 29953 29937.29938.29943.29953

我正在使用excel（ado with jet），input表是csv，jet不支持recursion自连接，并且层次数一直在变化。

Answer 1

答案介绍

随着最新的更新，我相信我对你所寻找的sorting顺序有了更好的理解，尽pipe我仍然有疑问。 但是，您的要求可能对您而言是独一无二的，所以如果我完全了解了您的要求并提供了您需要的确切代码，那么这个答案对其他人来说就没有多大用处。

我相信下面的例程可以满足你的要求，但是对于定制sorting顺序的其他人也是有用的。

你可以跳到代码的上面，解释如何安装它。 然后，您可以尝试macrosTest ，它提供了四个如何使用macrosQuickSort创build不同序列的例子。 正如我后面解释的，我相信示例3将是您的要求的一个有用的起点。

本文大部分解释了我如何使用一些鲜为人知的VBAfunction来创build一个灵活的sorting例程，可以在包括我相信你在内的许多情况下使用。

要求的范围

在我之前回答的代码中，我有：

 Call SimpleSort(StrArray) 

如果你search互联网的VBAsorting例程，你会发现许多具有相似的参数。 StrArray是一个string数组。 例程将交换元素之间的值，以便在返回时，值按升序排列。

一个常见的变化是：

 Call SimpleSort(StrArray, InxLow, InxHigh) 

这使您可以指定只对数组的一部分进行sorting。

这给了一点灵活性，但例程仍然按升序排列一串string。 这个例程不会对long数组或long double数组进行sorting，也不会将string数组sorting为降序或将任何东西sorting为定制的序列。

我可以使StrArray成为一个变体数组，所以它可以包含string或长StrArray或双精度。 但是，其他例程可能会要求数组被正确input，所以这并不总是一个方便的解决scheme。

我可以添加一个布尔参数与True意义sorting值为升序和False意义sorting值降序。 我将不得不在sorting例程中find哪里，它决定是否需要交换，并引入If-then-else-End-If。

但是，如果我想要其他的序列，这将无济于事。 你要升序，但不是数组元素值的升序 。 你想sorting看别的地方，以决定是否元素X之前元素Y.试图用定制的代码replace现有的我的交换代码将是棘手的，只会解决今天的问题。 针对每个不同的序列具有不同的sorting例程可能变得难以pipe理。

一个不常见的要求，可能与你有关，是数组的序列是不能改变的。 也许数组包含很长的string; 在元素之间交换长string很慢。 也许它是VBA调用用户types的数组，但大多数语言都调用结构体; 在结构之间交换值通常必须按字段执行。 也许不可能把数组重新排列成原始序列，所以一定不要被打扰。

当您不希望对目标数组进行sorting时，标准技术是有一个索引数组。 假设我有一个目标数组，我不想sorting，但我想按字母顺序访问：

 Element No 1 2 3 4 5 6 7 8 9 Target DCEAIGFHB 

我创build数组索引并初始化它：

 Element No 1 2 3 4 5 6 7 8 9 Target DCEAIGFHB Index 1 2 3 4 5 6 7 8 9 

然后我根据Target中的值对Index数组进行sorting：

 Element No 1 2 3 4 5 6 7 8 9 Target DCEAIGFHB Index 4 9 2 1 3 7 6 8 5 

这给了：

• Index(1) = 4和Target(Index(1)) = "A"
• Index(2) = 9和Target(Index(2)) = "B"
• Index(3) = 2和Target(Index(3)) = "C"

也就是说， Index允许以期望的顺序访问Target元素，而无需更改Target 。

上面我试图描述你将要或可能会需要的function。 如果要按升序排列string数组，可以在Internet上轻松find合适的例程。 如果你想要任何其他types的例程，你必须适应这些例程之一或自己的代码。 如果您要自己修改/编写代码，那么可能还需要包含所需的所有function，因为额外的function通常更容易debuggingsorting例程。 如果可以避免的话，你不希望有多个sorting例程。

我希望在我的一个sorting例程中看到的function：

1. 能够sorting任何types的数组。
2. 创build一个有序的索引数组而不是一个有序的目标数组。
3. 能够sorting成任何顺序

有用的技术1 – ParamArray

需求2 – 创build一个有序的索引数组而不是一个有序的目标数组 – 有一点棘手，但是不需要特殊的VBA知识。

要求1 – 能够sorting任何types的数组 – 变得容易，如果你知道ParamArrays。 我常常感到惊讶的是，ParamArrays不是更好的了解，而是因为它们非常有用而被使用得更充分。

在大多数VBA教程早期，你被教导宣布一个子例程。 例如：

 Sub MySub(ByRef Param1() As String, ByVal Param2 As Long) : : : : : End Sub 

我可以指定Param2是可选的，所以我可以用一个或两个参数调用MySub ，但这是这种声明的灵活性的限制。 另一种风格是：

 Sub MySub(ByRef Param1() As String, ByVal Param2 As Long , _ ParamArray Extra() As Variant) : : : : : End Sub 

一个ParamArray只能是最后一个参数。 在这里，我已经指定了两个固定参数，每个调用中都必须存在，然后是零个或多个其他参数。 所以，例如，我可能会：

 Call MySub(StrArrayA, 5, 26.1, "abcdef", StrArrayB) 

在MySub中：

• 引用Param1访问StrArrayA 。 因此， Param1(5) = "a"将StrArrayA(5)为=“a”。
• 参数2 = 5
• 额外（0）= 26.1
• Extra（1）=“abcdef”
• 对Extra(2)访问StrArrayB 。

ParamArray的下界将始终为零。 编译器对这些额外参数的性质一无所知。 如果MySub要求第一个额外的参数是一个double，那么程序员必须使用函数VarType来检查它是否是double。

我不打算描述你可以用ParamArrays做的所有奇妙的事情，因为这超出了这个答案的范围。

所有你需要知道的是我提供的sorting例程的最后一个参数是Target数组，它是一个ParamArray，所以它可以是一个string，双精度，长整数或任何其他基本types的数组。

我想我可以说目标数组可以是任何types，但我发现这是不真实的。 这超出了您当前的要求范围。 我最后讨论这个问题的完整性。

有用的技术2 – 运行

您可以按名称运行macros。 例如：

  Result = Application.Run(QSequenceName, Param1, Param2, Param3, …) 

你可以做更多的Run比我需要或在这里指定。 QSequenceName是sorting例程的参数。 您必须编写一个布尔函数来告诉sorting例程所需的两个值序列。 sorting例程对Target数组和您想要的序列一无所知。 名为“QSequenceName”的布尔函数知道目标数组的types和所需的序列。 是的，你必须对这个布尔函数进行编码，但是你不必修改sorting例程来得到你需要的sorting顺序。

考虑：

 Function StrDescend(Target() As String, Index() As Long, Inx1 As Long, Inx2 As Long) As Boolean StrDescend = IIf(Target(Index(Inx1)) >= Target(Index(Inx2)), True, False) End Function 

这是我写的一个布尔函数来演示sorting例程。 参数必须是：

• Target ：需要sorting索引的数组
• Index ：在sorting结尾的数组将定义Target的序列。
• Inx1 ：索引到第一个元素的Index 。 注意macros如何使用Target(Index(Inx1)来访问第一个元素的值。
• Inx2 ：索引到第二个元素的Index 。

如果两个值相等，或者元素1在最后一个序列中的元素2之前，则该函数必须返回True 。 如果元素1在最后一个序列中位于元素2之后，则该函数必须返回False 。

StrDescend就是这样一个函数的一个简单例子，并且使用Target的元素值。 下面的代码包含的例子说明了测序的复杂程度。

使用此函数的sorting例程的调用是：

 Call QuickSort(True, Index, LBound(KeyStr), UBound(KeyStr), "StrDescend", KeyStr) 

• 对于你来说，第一个参数将始终为True 。
• 第二个参数是一个Long数组，其中sorting的索引将被返回。
• LBound(KeyStr)和UBound(KeyStr)指定要对整个目标进行sorting。 如果只对目标数组的一部分进行sorting，则可以调整这些值。
• "StrDescend"是指定QuickSortsorting顺序的布尔函数的名称。
• KeyStr是目标数组。

QuickSort的参数在macros的顶部指定。 你说你发现recursion困难。 QuickSort是recursion的，所以我build议你忽略它是如何工作的; 只是想一下如何使用它来实现你所需要的顺序。

---

你应该忽略这个部分，直到你已经运行macrosTest并理解它如何实现前三种。 最后的顺序要复杂得多，而且我确信远远超出了你目前的要求。 我想要展示QuickSort可以实现的function。 忽略最后的sorting和本节，直到（除非？）你完全满意前三种。

我想要展示QuickSort如何对一组用户types进行sorting。 我定义了一个用户typesPerson和一个用户typesChild，其中Person包含一个Childtypes的数组。 然后我试图对Persontypes的数组进行sorting。 我发现我无法在ParamArray中传递一组用户types。 我不知道我以前怎么没能达到这个限制。

我将这两个用户types转换为一个粗糙的类。 我不想提供关于类或集合的教程。 我只想说，这是一个如何不构build一个类的例子。 然而，足以certificateQuickSort将创build一个索引到一系列的人给出的序列：没有孩子的人，然后人按照最小的孩子的降序。 我不确定为什么有人会想要这个序列，但我认为这是一个很容易理解的例子。

---

创build一个新的工作簿。

创build一个新的类模块并将其命名为CPersonData 。 （使用F4访问类模块的属性，Name是第一个属性。）将此代码复制到类模块：

 Public NameFamily As String Public NameGiven As String ' * Example values for ChildNameGiven: ' George ' George:Jane ' George:Jane:Mary ' * Example values for ChildNameAge: ' 5 ' 5:4 ' 5:4:10 ' * ChildNameGiven and ChildAge must have the same number of colons with the ' parts separated by colons matched by position. In the third examples above: ' George is 5, Jane is 4 and Mary is 10. Public ChildNameGiven As String Public ChildAge As String 

创build一个普通模块并将其复制到它：

 Option Explicit Dim AlphabetSequence() As Variant Sub Test() Dim ChildNamePart() As String Dim ChildAgePart() As String Dim Index() As Long Dim InxChildCrnt As Long Dim InxCrnt As Long Dim InxPerson As Long Dim KeyStr() As String Dim NumChildren As Long Dim Person() As CPersonData ' Create array of strings and output to immediate window ' ====================================================== ReDim KeyStr(1 To 12) KeyStr(1) = "B": KeyStr(2) = "F": KeyStr(3) = "C" KeyStr(4) = "E": KeyStr(5) = "A": KeyStr(6) = "D" KeyStr(7) = "I": KeyStr(8) = "H": KeyStr(9) = "G" KeyStr(10) = "I": KeyStr(11) = "E": KeyStr(12) = "A" Debug.Print " Array seq "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & InxCrnt, 3) & " "; Next Debug.Print Debug.Print " Key "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & KeyStr(InxCrnt), 3) & " "; Next Debug.Print Debug.Print ' Sort KeyStr into ascending sequence and output to immediate window ' ================================================================== Call QuickSort(True, Index, LBound(KeyStr), UBound(KeyStr), "StrAscend", KeyStr) Debug.Print " Ascending "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & InxCrnt, 3) & " "; Next Debug.Print Debug.Print " Index "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & Index(InxCrnt), 3) & " "; Next Debug.Print Debug.Print " Key "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & KeyStr(Index(InxCrnt)), 3) & " "; Next Debug.Print Debug.Print ' Sort KeyStr into descending sequence and output to immediate window ' =================================================================== Call QuickSort(True, Index, LBound(KeyStr), UBound(KeyStr), "StrDescend", KeyStr) Debug.Print "Descending "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & InxCrnt, 3) & " "; Next Debug.Print Debug.Print " Index "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & Index(InxCrnt), 3) & " "; Next Debug.Print Debug.Print " Key "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & KeyStr(Index(InxCrnt)), 3) & " "; Next Debug.Print Debug.Print AlphabetSequence = Array("A", "E", "I", "O", "U", "B", "C", "D", "F", "G", "H", "J", "K", _ "L", "M", "N", "P", "Q", "R", "S", "T", "V", "W", "X", "Y", "Z") ' Sort KeyStr into vowels first then consonants and output to immediate window. ' The sequence vowels the consinants is defined by the array AlphabetSequence. ' ============================================================================ Call QuickSort(True, Index, LBound(KeyStr), UBound(KeyStr), "VowelFirst", KeyStr) Debug.Print " Vowel 1st "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & InxCrnt, 3) & " "; Next Debug.Print Debug.Print " Index "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & Index(InxCrnt), 3) & " "; Next Debug.Print Debug.Print " Key "; For InxCrnt = LBound(KeyStr) To UBound(KeyStr) Debug.Print Right(" " & KeyStr(Index(InxCrnt)), 3) & " "; Next Debug.Print ' Create array of persons ' ======================= ReDim Person(0 To 5) Set Person(0) = New CPersonData Person(0).NameFamily = "Brown" Person(0).NameGiven = "Adrian" Person(0).ChildNameGiven = "George" Person(0).ChildAge = "5" Set Person(1) = New CPersonData Person(1).NameFamily = "Green" Person(1).NameGiven = "Barbara" Person(1).ChildNameGiven = "" Person(1).ChildAge = "" Set Person(2) = New CPersonData Person(2).NameFamily = "Smith" Person(2).NameGiven = "Charles" Person(2).ChildNameGiven = "Harriet:Ian:Jane" Person(2).ChildAge = "4:7:11" Set Person(3) = New CPersonData Person(3).NameFamily = "Farmer" Person(3).NameGiven = "Diana" Person(3).ChildNameGiven = "" Person(3).ChildAge = "" Set Person(4) = New CPersonData Person(4).NameFamily = "Roe" Person(4).NameGiven = "Eric" Person(4).ChildNameGiven = "Kenneth:Laura" Person(4).ChildAge = "10:1" Set Person(5) = New CPersonData Person(5).NameFamily = "Walker" Person(5).NameGiven = "Fawn" Person(5).ChildNameGiven = "" Person(5).ChildAge = "" ' Output Person array to Immediate window ' ======================================= Debug.Print Debug.Print "Sequence within Person array" For InxPerson = LBound(Person) To UBound(Person) Debug.Print Person(InxPerson).NameGiven & " " & Person(InxPerson).NameFamily ChildNamePart = Split(Person(InxPerson).ChildNameGiven, ":") ChildAgePart = Split(Person(InxPerson).ChildAge, ":") For InxChildCrnt = 0 To UBound(ChildNamePart) If ChildNamePart(InxChildCrnt) <> "" Then Debug.Print " " & ChildNamePart(InxChildCrnt) & " (" & _ ChildAgePart(InxChildCrnt) & ")" End If Next Next ' Sort Person array into sequence defined by function "AscendAgeYoungestChild" ' ============================================================================ Call QuickSort(True, Index, LBound(Person), UBound(Person), "AscendAgeYoungestChild", Person) ' Output Person array in sequence specified by Index ' ================================================== Debug.Print Debug.Print "Persons without children first then descending order of youngest child" For InxCrnt = LBound(Index) To UBound(Index) InxPerson = Index(InxCrnt) Debug.Print Person(InxPerson).NameGiven & " " & Person(InxPerson).NameFamily ChildNamePart = Split(Person(InxPerson).ChildNameGiven, ":") ChildAgePart = Split(Person(InxPerson).ChildAge, ":") For InxChildCrnt = 0 To UBound(ChildNamePart) If ChildNamePart(InxChildCrnt) <> "" Then Debug.Print " " & ChildNamePart(InxChildCrnt) & " (" & _ ChildAgePart(InxChildCrnt) & ")" End If Next Next End Sub Sub QuickSort(ByVal TopLevel As Boolean, ByRef Index() As Long, _ ByVal InxLow As Long, ByVal InxHigh As Long, _ QSequenceName As String, ParamArray Target() As Variant) ' * Original algorithm developed by CAR Hoare in 1960. ' * This implementation based on Pascal procedure published in second edition ' of Algorithms by Robert Sedgewick. ' * Converted to VBA by Tony Dallimore and amended to: ' * Sort Index array rather than Key array ' * Use function passed as parameter to determine if two elements are in ' the correct sequence to avoid hard-coding the required sequence into ' this routine. ' * Parameters: ' * TopLevel True for the outer call; False for inner calls ' Index is only initialised for an outer call ' * Index At start of outer call dimensioned to (InxLow To InxHigh) ' and initialised to InxLow, InxLow+1, InxLow+2, ... . ' On final exit, elements InxLow to InxHigh will define the ' sequence of elements InxLow to InxHigh of the Key array. ' * InxLow Identifies the first element of the Key array to be sorted ' * InxHigh Identifies the last element of the Key array to be sorted ' InxLow must be less than or equal to InxHigh ' If InxLow and InxHigh are set to the lower and upper bounds ' of the key array, the entire array will be sorted. ' * QSequenceName The name of the boolean function that determines if two ' elements of the Target array are in the required sequence. The ' function must return False if the elements are not in the ' correct sequence. ' Parameters are: ' * Target array ' * Index array ' * Index of first element within Index ' * Index of second element within Index ' * Target Target is a ParamArray. It will contain every parameter after ' QSwapName. There should only be one such parameter which is ' the Target array. Target is a zero-based array so Target(0) ' is the array whose required sequence is to be returned in Index. ' This routine does not know the nature of the Target array or ' the nature of the desired sequence. ' * The unmodified algorithm is recursive. It first partitions the elements of ' the Key array such that: ' * The element Key(X) is in its final place for some X. ' * All elements Key(InxLow) to Key(X-1) will come before Key(X) in the fully ' sorted array. ' * All elements Key(X+1) to Key(InxHigh) will come after Key(X) in the fully ' sorted array. ' It then calls itself twice: once for elements Key(InxLow) to Key(X-1) and once ' for elements Key(X+1) to Key(InxHigh). ' * In this implementation the Key array is replaced by a Target array. This routine ' does not know the type of the Target or what information within an element ' determines the desired sequence. On exit, Index will have been sorted so, for ' all X in the range InxLow to InxHight, Index(X) specifies the position of ' Target(Index(X))in the sequence specified by function QSequenceName. Dim InxCrnt As Long Dim InxHighTemp As Long Dim InxLowTemp As Long Dim InxPartition As Long Dim InxTemp As Long Dim CorrectSequence As Boolean If TopLevel Then ' Only initialise Index for the outer call ' Size Index array to match InxLow to InxHigh ReDim Index(InxLow To InxHigh) ' Initialise Index array For InxCrnt = InxLow To InxHigh Index(InxCrnt) = InxCrnt Next End If ' Initialise indices for partitioning InxLowTemp = InxLow - 1 InxHighTemp = InxHigh ' My understanding is that the algorithm does not depend on which element of the ' Target array is the partitioning element. In this implementation it is element ' InxHigh. InxPartition = InxHigh Do While InxHighTemp > InxLowTemp ' Step InxLowTemp until Target element InxLowTemp is not to come before ' Target element InxPartition in the final sequence Do While InxLowTemp < InxHigh InxLowTemp = InxLowTemp + 1 If InxLowTemp = InxPartition Then Exit Do CorrectSequence = Application.Run(QSequenceName, Target(0), Index, InxLowTemp, InxPartition) If Not CorrectSequence Then Exit Do Loop ' Reduce InxHighTemp until Target element InxHighTemp is not to come after ' Target element InxPartition in the final sequence Do While InxHighTemp > InxLow InxHighTemp = InxHighTemp - 1 'Debug.Assert InxHighTemp <> 0 CorrectSequence = Application.Run(QSequenceName, Target(0), Index, InxPartition, InxHighTemp) If Not CorrectSequence Then Exit Do Loop ' Swap position of InxLowTemp and InxHighTemp InxTemp = Index(InxLowTemp) Index(InxLowTemp) = Index(InxHighTemp) Index(InxHighTemp) = InxTemp Loop ' Final swap. Index(InxHighTemp) = Index(InxLowTemp) Index(InxLowTemp) = Index(InxPartition) Index(InxHigh) = InxTemp ' Sort the two halves of the array unless they are less than two elements wide If InxLowTemp > InxLow Then Call QuickSort(False, Index, InxLow, InxLowTemp - 1, QSequenceName, Target(0)) End If If InxLowTemp < InxHigh Then Call QuickSort(False, Index, InxLowTemp + 1, InxHigh, QSequenceName, Target(0)) End If End Sub Function AscendAgeYoungestChild(Person() As CPersonData, Index() As Long, _ Inx1 As Long, Inx2 As Long) As Boolean ' * If Person(Index(Inx1)) has no children, return True ' * If Person(Index(Inx1)) has children but Person(Index(Inx2)) ' does not, return False ' * If both Person(Index(Inx1)) and Person(Index(Inx2)) have children, ' return True if Person(Index(Inx1))'a youngest child is older than ' Person(Index(Inx2))'s youngest child Dim ChildAgePart() As String Dim InxChild As Long Dim InxInx1 As Long Dim InxInx2 As Long Dim NumChildren1 As Long Dim NumChildren2 As Long Dim AgeYoungest1 As Long Dim AgeYoungest2 As Long InxInx1 = Index(Inx1) InxInx2 = Index(Inx2) If Person(InxInx1).ChildAge = "" Then ' Person(Index(Inx1)) has no children. If Person(Index(Inx2)) has children, ' Person(Index(Inx2)) is to come first in the required sequence. If ' Person(Index(Inx2)) has no children, Person(Index(Inx1)) and ' Person(Index(Inx2)) are "equal" and the current sequence is OK. ' Either way, return True AscendAgeYoungestChild = True Exit Function End If If Person(InxInx2).ChildAge = "" Then ' Person(Index(Inx1)) has children but Person(Index(Inx2)) doe not AscendAgeYoungestChild = False Exit Function End If ' Both persons have children ' Find age of youngest child of Person(Index(Inx1)) ChildAgePart = Split(Person(InxInx1).ChildAge, ":") AgeYoungest1 = Val(ChildAgePart(0)) For InxChild = 1 To UBound(ChildAgePart) If AgeYoungest1 > Val(ChildAgePart(InxChild)) Then AgeYoungest1 = Val(ChildAgePart(InxChild)) End If Next ' Find age of youngest child of Person(Index(Inx2)) ChildAgePart = Split(Person(InxInx2).ChildAge, ":") AgeYoungest2 = Val(ChildAgePart(0)) For InxChild = 1 To UBound(ChildAgePart) If AgeYoungest2 > Val(ChildAgePart(InxChild)) Then AgeYoungest2 = Val(ChildAgePart(InxChild)) End If Next If AgeYoungest1 > AgeYoungest2 Then AscendAgeYoungestChild = True Else AscendAgeYoungestChild = False End If End Function Function StrAscend(Target() As String, Index() As Long, Inx1 As Long, Inx2 As Long) As Boolean ' Return True if element Index(Inx1) is to come before element Index(Inx2) ' in the final sequence which is ascending alphanumeric StrAscend = IIf(Target(Index(Inx1)) <= Target(Index(Inx2)), True, False) End Function Function StrDescend(Target() As String, Index() As Long, Inx1 As Long, Inx2 As Long) As Boolean ' Return True if element Index(Inx1) is to come before element Index(Inx2) ' in the final sequence which is descending alphanumeric StrDescend = IIf(Target(Index(Inx1)) >= Target(Index(Inx2)), True, False) End Function Function VowelFirst(Target() As String, Index() As Long, Inx1 As Long, Inx2 As Long) As Boolean ' Return True if element Index(Inx1) is to come before element Index(Inx2) ' in the final sequence which is the sequence defined by AlphabetSequence ' which is vowels then consonants Dim FirstLetter As String Dim InxAlpha1 As Long Dim InxAlpha2 As Long ' First first letter of Target(Inx1) in AlphabetSequence FirstLetter = Left(Target(Index(Inx1)), 1) For InxAlpha1 = LBound(AlphabetSequence) To UBound(AlphabetSequence) If AlphabetSequence(InxAlpha1) = FirstLetter Then Exit For End If Next FirstLetter = Left(Target(Index(Inx2)), 1) For InxAlpha2 = LBound(AlphabetSequence) To UBound(AlphabetSequence) If AlphabetSequence(InxAlpha2) = FirstLetter Then Exit For End If Next If InxAlpha1 <= InxAlpha2 Then VowelFirst = True Else VowelFirst = False End If End Function 

运行macrosTest并研究前三个sorting序列的输出。 我想例3是最接近你的要求。 您可以将seq_num列加载到数组，并使用函数VowelFirst作为起点。

如果有必要的话，回过头来问一些问题，但是从自己的研究中可以了解的越多，开发的速度越快。