excel vba排列超过1048576行

时间:2014-09-02 06:57:17

标签: excel excel-vba vba

我正在尝试在excel中为6个数字创建一个排列列表,每个数字都在他们自己的列A-F中,每个数字都是1-38。当我运行VBA时,我发现排列远远超过excel中可用的行1048576,因此VBA在该点结束。我想要一个VBA,当行在任何纸张上达到1048576并且排列没有完成时,它将只创建一个新纸张并继续它停在前一张纸上并自动创建纸张直到排列结束。我已经搜索了通过的问题但没有找到帮助。非常感谢任何专家的帮助。

代码:

   Sub Perm()

   Dim a As Integer
   Dim b As Integer
   Dim c As Integer
   Dim d As Integer
   Dim e As Integer
   Dim f As Integer

    n = 1

For a = 1 To 38
For b = 1 To 38
    For c = 1 To 38
        For d = 1 To 38
            For e = 1 To 38
                For f = 1 To 38
Cells(n, 1).Value = a
        Cells(n, 2).Value = b
                Cells(n, 3).Value = c
                        Cells(n, 4).Value = d
                                Cells(n, 5).Value = e
                                        Cells(n, 6).Value = f

                n = n + 1


                Next f
            Next e
        Next d
      Next c
    Next b
  Next a

 End Sub

1 个答案:

答案 0 :(得分:2)

这应该适合你:

Sub Perm()

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim n As Long

Dim maxRows As Long
Dim sheetNumber As Integer
Dim loopCounter As Integer

 maxRows = 1048576
 loopCounter = 38

 sheetNumber = 1
 n = 1

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Sheet-" & sheetNumber

Application.ScreenUpdating = False

For a = 1 To loopCounter
For b = 1 To loopCounter
    For c = 1 To loopCounter
        For d = 1 To loopCounter
            For e = 1 To loopCounter
                For f = 1 To loopCounter


                  Cells(n, 1).Value = a
                  Cells(n, 2).Value = b
                  Cells(n, 3).Value = c
                  Cells(n, 4).Value = d
                  Cells(n, 5).Value = e
                  Cells(n, 6).Value = f

                  If n = maxRows Then
                       sheetNumber = sheetNumber + 1
                       ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
                       ActiveSheet.Name = "Sheet-" & sheetNumber
                       n = 0
                  End If

                  n = n + 1

                Next f
            Next e
        Next d
      Next c
    Next b
  Next a

Application.ScreenUpdating = False

End Sub

这将创建一个名为“Sheet-1”的工作表,并将其填充到第1048576行。 然后它将创建一个名为“Sheet-2”的新工作表并重复直到它已满,等等。

最好禁用ScreenUpdating进行密集的单元格写入,因为它会大大缩短运行时间。

祝你好运,因为它可能需要一段时间。正如另一张海报所说,它将需要近3000个工作表。希望你的机器上有足够的内存。