排序行Excel VBA宏 [英] Sorting Groups of Rows Excel VBA Macro

问题描述

我无法弄清楚如何在VBA中创建排序算法，从而排序和交换一组行（每行几行）。我使用下面的数组写了一个成功的排序算法：

I am having trouble figuring out how to create a sorting algorithm in VBA that sorts and swaps groups of rows (several rows at a time). I wrote a successful sorting algorithm using an array below:

Function SortArray(ByRef arrToSort As Variant)
Dim aLoop As Long, aLoop2 As Long
Dim str1 As String
Dim str2 As String
For aLoop = 1 To UBound(arrToSort)
   For aLoop2 = aLoop To UBound(arrToSort)
        If UCase(arrToSort(aLoop2)) < UCase(arrToSort(aLoop)) Then
            str1 = arrToSort(aLoop)
            str2 = arrToSort(aLoop2)
            arrToSort(aLoop) = str2
            arrToSort(aLoop2) = str1
        End If
    Next aLoop2
Next aLoop
SortArray = arrToSort

（其中每个元素是数组的元素），但是现在我想通过交换行或一组行进行排序。我会在下面解释一下我的意思。

(where each element is an element of an array) but now I want to sort by swapping rows or groups of rows. I'll explain what I mean below.

我有一个工作表，顶部有标题和下面的数据行：

I have a worksheet with headers at the top and rows of data underneath:

我想写一个像上面的算法一样的命令。然而，而不是交换数组的元素，我想交换整组行。 Header3（（可以是任何字符串））确定分组。工作表上的所有组都会单独排序和分组。

I want to write a command that works like the algorithm above. HOWEVER, instead of swapping elements of an array I want to swap entire groups of rows. Header3 ((Can be any string) determines the grouping. All groups on the worksheet are sorted individually and a grouping.

为了进行交换分组行，我写了后面的Sub RowSwapper（）将包含两个包含要交换的行的字符串（例如，以rws1 =3：5的形式）。

In order to do swap grouped rows, I wrote the following sub RowSwapper() that takes in two strings containing the rows to swap. (e.g. in the form rws1 = "3:5").

Public Sub RowSwapper(ByVal rws1 As String, ByVal rws2 As String)
'ACCOMODATE VARIABLE ROW LENGTHS!!!!
    ActiveSheet.Rows(rws1).Cut
    ActiveSheet.Rows(rws2).Insert Shift:=xlDown
    ActiveSheet.Rows(rws2).Cut
    ActiveSheet.Rows(rws1).Insert Shift:=xlDown
    MsgBox "RowSwapper: row" & rws1 & "swapped with row " & rws2
End Sub

任何想法？我的策略，包括代码如下：

Any ideas? My strategy, including code, is listed below:

我的策略：
我有数组prlst和srtdPrLst。prLst是一个数组排序优先级在prLst中的优先级的位置是列（标题）它指的是srtdPrLst是包含以数字升序排序的优先级数组（例如1,2,3 ....）的数组。

MY STRATEGY: I have the arrays prLst and srtdPrLst. prLst is an array of sorting priorities. The position of the priority in prLst is the column (header) to which it refers. srtdPrLst, is an array containing those priorities sorted in numerically ascending order (e.g. 1,2,3....)

我在调用函数FindPosition时循环访问srtdPrLst，以查找每个优先级的位置。我向后循环，以便以正确的顺序进行排序。

I loop through srtdPrLst while calling function FindPosition to find position of each priority. I loop backwards in order to sort in the proper order.

要对行的行进行排序，我使用与上述SortArray代码相同的技术。但是，我需要收集组中存在的行。为此，我有两个Do While循环嵌套在for循环下，每个组有一个（因为我正在比较两组）。这些行存储在变量grpCnt1（对于第一个比较组）和grpCnt1（用于第二个比较组）。

To sort groups of rows, I then use the same technique as the SortArray code above. However, I need to gather the rows in which a group exists. To do this, I have two Do While loops nested under the for loops, one for each group (since I am comparing two groups at). These rows are stored in variables grpCnt1 (for first compared group) and grpCnt1 (for second compared group).

由于各个组已经排序，我只需要比较每个组的第一行。我将grp1Val与grp2Val的字符串与简单的If语句进行比较。如果字符串不是字母顺序，我调用rowSwapper（上面列出）来交换它们。

Since individual groups are already sorted, I only need to compare the first row of each group. I compare the strings grp1Val with grp2Val with a simple If statement. If the strings are not in alphabetical order, I call rowSwapper (listed above) to swap them.

描述的代码如下：

lstRowVal = Int（ActiveSheet.Range（AB& totCount）.Value）
'数组prLst中的索引是将优先级分配给
'因此，pos =列号
'向后排序，以获得优先级顺序
'MsgBoxmarker =&标记

lstRowVal = Int(ActiveSheet.Range("AB" & totCount).Value) 'The index in the array prLst is the column at which a priority is assigned to 'therefore, pos = column number 'Sorts backwards in order to get priorities in appriopriate order 'MsgBox "marker = " & marker

For prior2 = Int(UBound(srtdPrLst)) To 1 Step -1
    MsgBox "prior2 = " & prior2
    If Int(srtdPrLst(prior2)) > 0 Then
        pos = FindPosition(Int(srtdPrLst(prior2)), prLst)

        'Algorithm to sort groups
        For lLoop = 2 To lstRowVal '2 b/c Starts at row below headers


            'Find first group to compare
            grp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop).Value
            hdToGrp1Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop).Value

            Do
                'nextGrp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & (lLoop + grpCnt1)).Value
                nxtHdToGrp1 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop + grpCnt1)).Value
                grpCnt1 = grpCnt1 + 1
            Loop While nxtHdToGrp1 = hdToGrp1Val


           For lLoop2 = lLoop To lstRowVal 

                'Find second group to compare
                grp2Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop2).Value
                hdToGrp2Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop2).Value

                Do
                    nxtHdToGrp2 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop2 + grpCnt2)).Value
                    grpCnt2 = grpCnt2 + 1
                Loop While nxtHdToGrp2 = hdToGrp2Val

                If UCase(grp2Val) < UCase(grp1Val) Then
                    RowSwapper lLoop & ":" & (lLoop + grpCnt1), lLoop2 & ":" & (lLoop2 + grpCnt2) 
                End If

                grp2Val = ""
                lLoop2 = lLoop2 + grpCnt2
                grpCnt2 = 0

            Next lLoop2


            grp1Val = ""
            lLoop = lLoop + grpCnt1
            grpCnt1 = 0

        Next lLoop
    End If
Next prior2

推荐答案

我同意问题仍然是一点不清楚您是否尝试从数据>排序...排序...您可以使用多个键进行排序并使用自定义列表。

I agree that the question is still a little unclear. Have you tried doing a sort from the Data>Sort... You can sort using multiple keys and use custom lists.

此外，由于你说你想要一些VBA上的指针... :)我不认为像

Additionally since you said you wanted some pointers on the VBA...:) I don't think stuff like

Dim letString, idLabel, curCell As String

做你期待的这里实际发生的是

is doing what you are expecting. What is actually happening here is

Dim letString as Variant, idLabel as Variant, curCell As String

因为你不会在每个变量之后指定。我假设你想要的是：

because you don't specify after each variable. I assume what you want here is actually:

Dim letString as String, idLabel as String, curCell As String

其次，如果您关心效率，就像上次的评论一样，我将避免使用.select操作范围的方法。没有它可以在excel中做任何事情。这只是一个额外的负担。所以不要像 Selction.Resize（1）这样的东西，而是选择，你可以将rand的开头和结尾的位置记录在一个整数变量中，然后把它改成一个范围一旦满足您的所有标准，就对象。你可以将这个范围的对象加入你的排序功能。

Second, if you are concerned about efficiency like in your last comment then I would avoid using the .select method of manipulating ranges. You can do everything in excel without it. It is just an extra burden. So instead of doing something like Selction.Resize(1).Select you could log the locations of the beginning and end of your rand in an integer variable then change it into a range object once all your criteria are met. You can feed this range object into your sorting function.

只是一些东西要咀嚼。

这篇关于排序行Excel VBA宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！