循环内的VBA偏移 - 永远运行

dmi*_*hel 2 excel vba excel-vba

我对编程很陌生,我觉得VBA对我来说是个好地方,因为我在Excel上做了很多工作.

我创建了一个宏,它从输入框中取一个整数(我一直在使用2,3和4来测试),它创建了一个这个数字的4层层次结构的集合; 例如输入"2"会产生

1.0.0.0
1.0.0.1
1.0.0.2
1.0.1.0
1.0.1.1
1.0.1.2 etc.
Run Code Online (Sandbox Code Playgroud)

我让宏按预期工作,但它需要永远运行.我认为循环中的偏移会减慢它的速度.有没有人有任何建议来加快这个速度?任何一般反馈也是受欢迎的.

Sub Tiers()

'Input Box
Dim Square As Integer
Square = InputBox("Enter Number of Tiers")
Range("f5").Select
Selection.Value = 0
 With Application
    .ScreenUpdating = False
End With

'Rows down
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer

'Start For loops
For g = 1 To Square
    For h = 0 To Square
        For i = 0 To Square
            For j = 0 To Square

                'calculate offsets and place values of loop variables
                Dim step As Long
                step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)
                Selection.Offset(step, 0).Value = j
                Selection.Offset(step, -1).Value = i
                Selection.Offset(step, -2).Value = h
                Selection.Offset(step, -3).Value = g


            Next j
        Next i
    Next h
Next g

With Application
    .ScreenUpdating = True
End With

End Sub
Run Code Online (Sandbox Code Playgroud)

谢谢

Sid*_*out 6

继我在你的帖子下面的评论,循环和写这样的表格将太慢.写入数组,然后将数组写入工作表.这眨眼间就跑了.

这是你在尝试什么?

Sub Sample()
    Dim TempArray() As Long
    Dim n As Long
    Dim g As Long, h As Long, i As Long, j As Long
    Dim reponse As Variant

    '~~> Accept only numbers
    reponse = Application.InputBox(Prompt:="Enter Number of Tiers", Type:=1)

    If reponse <> False Then
        For g = 1 To reponse
            For h = 0 To reponse
                For i = 0 To reponse
                    For j = 0 To reponse
                        n = n + 1
                    Next j
                Next i
            Next h
        Next g

        ReDim Preserve TempArray(1 To n, 1 To 4)
        n = 1

        For g = 1 To reponse
            For h = 0 To reponse
                For i = 0 To reponse
                    For j = 0 To reponse
                        TempArray(n, 1) = g
                        TempArray(n, 2) = h
                        TempArray(n, 3) = i
                        TempArray(n, 4) = j
                        n = n + 1
                    Next j
                Next i
            Next h
        Next g

        '~~> Replace this with the relevant sheet
        Sheet1.Range("A1").Resize(UBound(TempArray), 4).Value = TempArray
    End If
End Sub
Run Code Online (Sandbox Code Playgroud)

截图:

在此输入图像描述