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

时间:2014-01-11 17:24:51

标签: excel vba excel-vba

我的(日记帐分录模板)工作簿包含50多张。 模板布局允许快速上传到会计软件,减少输入时间。 但每个月所需的期刊类型不同。 表格是特定于名称的,例如“奖金”,“电力应计”,“销售”等 第一张纸被命名为“指令”,并且有一个宏,它按照实际顺序列出书中每张纸的第1行到第1行。 的期望: 要在第B行第1行到第50行输入,我想要的数字顺序,例如 目前的订单是:说明1本月需要:1                   销售2 4                   奖金3 2                   电力应计4 3 需要宏功能:查看B列中的数字并按顺序对表格进行排序。

这会阻止我每次想要特定纸张时都要扫描所有纸张。 同样,如果我以后需要审查每张表以进行管理报告 感激不尽

1 个答案:

答案 0 :(得分:0)

以下内容将读取“指令”工作表中的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