按宏排序的 Excel 2010 工作簿工作表

Question

我的（日记条目模板）工作簿包含 50 多张工作表。 模板布局允许快速上传到会计软件，减少输入时间。 但每个月所需的期刊类型不同。 工作表是特定名称的，例如“奖金”、“应计电费”、“销售额”等。 第一张表名为“指令”，并有一个宏，它按实际顺序在 A 列第 1 行到第 50 行列出书中的每张表。 期望： 要在 B 列的第 1 行到第 50 行中输入，我想要的数字顺序，例如 当前订单是：指令1本月要：1 销售额 2 4 奖金 3 2 电费应计 4 3 需要宏函数：查看 B 列中的数字并按该顺序对表格进行排序。

这将阻止我每次需要特定工作表时都必须扫描所有工作表。 同样，如果我以后需要查看管理报告的每张表 感激不尽

Answer 1

以下内容将读取“说明”工作表上的 A 列和 B 列，然后根据您在 B 列中输入的数字对工作表重新排序（假设 A 列中的名称正确）。

Option Explicit

Public Sub ReorderWorksheets()

    Dim numberOfSheets
    Dim sheetTargetPositions() As Variant
    Dim n As Long

    numberOfSheets = 50
    ReDim sheetTargetPositions(1 To 2, 1 To numberOfSheets)

    For n = 1 To numberOfSheets
        sheetTargetPositions(2, n) = ThisWorkbook.Worksheets("Instruction").Cells(n, 1).Value
        sheetTargetPositions(1, n) = ThisWorkbook.Worksheets("Instruction").Cells(n, 2)
    Next n

    Call QuickSort2(sheetTargetPositions, 1, 1)

    For n = 1 To numberOfSheets
        If n = 1 Then
            Call ThisWorkbook.Worksheets(sheetTargetPositions(2, n)).Move(, ThisWorkbook.Worksheets("Instruction"))
        Else
            Call ThisWorkbook.Worksheets(sheetTargetPositions(2, n)).Move(, ThisWorkbook.Worksheets(sheetTargetPositions(2, n - 1)))
        End If
    Next n

    ThisWorkbook.Worksheets("Instruction").Activate

End Sub

Public Sub QuickSort2(ByRef pvarArray As Variant, plngDim As Long, plngCol As Long, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim varSwap As Variant
    Dim c As Long
    Dim cMin As Long
    Dim cMax As Long

    cMin = LBound(pvarArray, plngDim)
    cMax = UBound(pvarArray, plngDim)
    Select Case plngDim
        Case 1
            If plngRight = 0 Then
                plngLeft = LBound(pvarArray, 2)
                plngRight = UBound(pvarArray, 2)
            End If
            lngFirst = plngLeft
            lngLast = plngRight
            varMid = pvarArray(plngCol, (plngLeft + plngRight) \ 2)
            Do
                Do While pvarArray(plngCol, lngFirst) < varMid And lngFirst < plngRight
                    lngFirst = lngFirst + 1
                Loop
                Do While varMid < pvarArray(plngCol, lngLast) And lngLast > plngLeft
                    lngLast = lngLast - 1
                Loop
                If lngFirst <= lngLast Then
                    For c = cMin To cMax
                        varSwap = pvarArray(c, lngFirst)
                        pvarArray(c, lngFirst) = pvarArray(c, lngLast)
                        pvarArray(c, lngLast) = varSwap
                    Next
                    lngFirst = lngFirst + 1
                    lngLast = lngLast - 1
                End If
            Loop Until lngFirst > lngLast
            If plngLeft < lngLast Then QuickSort2 pvarArray, plngDim, plngCol, plngLeft, lngLast
            If lngFirst < plngRight Then QuickSort2 pvarArray, plngDim, plngCol, lngFirst, plngRight
        Case 2
            If plngRight = 0 Then
                plngLeft = LBound(pvarArray, 1)
                plngRight = UBound(pvarArray, 1)
            End If
            lngFirst = plngLeft
            lngLast = plngRight
            varMid = pvarArray((plngLeft + plngRight) \ 2, plngCol)
            Do
                Do While pvarArray(lngFirst, plngCol) < varMid And lngFirst < plngRight
                    lngFirst = lngFirst + 1
                Loop
                Do While varMid < pvarArray(lngLast, plngCol) And lngLast > plngLeft
                    lngLast = lngLast - 1
                Loop
                If lngFirst <= lngLast Then
                    For c = cMin To cMax
                        varSwap = pvarArray(lngFirst, c)
                        pvarArray(lngFirst, c) = pvarArray(lngLast, c)
                        pvarArray(lngLast, c) = varSwap
                    Next
                    lngFirst = lngFirst + 1
                    lngLast = lngLast - 1
                End If
            Loop Until lngFirst > lngLast
            If plngLeft < lngLast Then QuickSort2 pvarArray, plngDim, plngCol, plngLeft, lngLast
            If lngFirst < plngRight Then QuickSort2 pvarArray, plngDim, plngCol, lngFirst, plngRight
    End Select
End Sub