我正在尝试在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
答案 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
进行密集的单元格写入,因为它会大大缩短运行时间。