代码修改

h9130p

Sub test()

    Dim Arr

    Columns("A:F").Sort Key1:=Range("E1"), Order1:=xlAscending, Key2:=Range("F1") _

        , Order2:=xlAscending, Header:=xlYes

    Columns("A:F").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _

        , Order2:=xlAscending, Header:=xlYes

    ROWL = Cells(65536, 1).End(3).Row

    ReDim Arr(1 To ROWL, 1 To 15)

    For I = 1 To 5

    Arr(1, I) = Cells(1, I)

    Next

    I = 2

    L = 1

    Do    ' Outer loop.

       L = L + 1

       Kmax = WorksheetFunction.Max(Kmax, K)

       K = 6

        For J = 1 To 5

            Arr(L, J) = Cells(I, J)

        Next

       Do While Cells(I, 5) = Arr(L, 5) ' Inner loop.

           Arr(L, K) = Cells(I, 6)

           K = K + 1

           I = I + 1

        Loop

      

    Loop Until Cells(I + 1, 1) = ""

    Sheets("考勤整理").Cells.ClearContents

    Sheets("考勤整理").[A1].Resize(L, Kmax) = Arr

  

   

    End Sub

各位大神好，这是我在论坛下载的某位大神的EXCEL，但是行数不够，我需要5W行以上，这个运行的时候总是提醒下标越界。求问怎么修改？

sunya_0529

看代码中，行数不超过65536应该都OK的，你最好上传一个附件上来，把你的需求和要实现的效果说清楚