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

时间:2018-10-02 16:30:32

标签: 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.

我使宏按预期工作,但是要花很长时间才能运行。我认为是循环中的偏移使速度变慢。有谁有任何建议来加快速度?也欢迎任何一般性反馈。

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

谢谢

2 个答案:

答案 0 :(得分: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

屏幕截图

enter image description here

答案 1 :(得分:1)

step计算似乎是多余的:

step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)

尝试以下操作:

Sub Tiers()

'Input Box
Dim Square As Long
Square = InputBox("Enter Number of Tiers")
With Application
    .ScreenUpdating = False
End With

'Rows down
Dim g As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim step As Long

step = 1

For g = 1 To Square
    For h = 0 To Square
        For i = 0 To Square
            For j = 0 To Square
                Range("F5").Offset(step, 0).Value = j
                Range("F5").Offset(step, -1).Value = i
                Range("F5").Offset(step, -2).Value = h
                Range("F5").Offset(step, -3).Value = g
                step = step + 1
            Next j
        Next i
    Next h
Next g

With Application
    .ScreenUpdating = True
End With

End Sub