我的 VBA 宏在更改一个单元格后崩溃

Question

我正在尝试制作一个宏来从工作簿的一个 sheet 中收集数据（它包含来自另一个系统的输出）并安排数据以使其在另一个 sheet 上可读。自从我上次编写任何代码以来已经有很长时间了，所以在构建它之前我查看了很多教程。

宏应该首先将“清单”中的所有相关单元格清零sheet。然后它查看“输入”sheet 并提取相关数据。不幸的是，它的宏在更改第一个单元格中的值后立即崩溃。

我可能在语法上犯了一些新手错误，但我似乎无法弄清楚哪里出了问题。

Sub Button1_Click()

Dim inv As Worksheet
Dim source As Worksheet
Dim productNum As String
Dim invI As Long
Dim sourceI As Long
Dim i As Long

Set inv = ThisWorkbook.Sheets("Inventory")
Set source = ThisWorkbook.Sheets("Input")

invI = 3
sourceI = 2
i = 3

With inv
Do Until productNum = "end"
    
    .Cells(i, 3) = 0
    .Cells(i, 4) = 0
    .Cells(i, 5) = 0
    .Cells(i, 6) = 0
    .Cells(i, 7) = 0
    .Cells(i, 8) = 0
    .Cells(i, 9) = 0
    .Cells(i, 10) = 0
    .Cells(i, 11) = 0
    .Cells(i, 12) = 0
    .Cells(i, 13) = 0
    .Cells(i, 14) = 0
    .Cells(i, 15) = 0
    .Cells(i, 16) = 0
    .Cells(i, 17) = 0
    .Cells(i, 18) = 0
    .Cells(i, 19) = 0
    .Cells(i, 20) = 0
    .Cells(i, 21) = 0
    .Cells(i, 22) = 0
    .Cells(i, 23) = 0
    .Cells(i, 24) = 0
    .Cells(i, 25) = 0
    .Cells(i, 26) = 0
    .Cells(i, 27) = 0
    .Cells(i, 28) = 0
    .Cells(i, 29) = 0
    .Cells(i, 30) = 0
            
    i = i + 1
    
    productNum = inv.Cells(i, 1).Value
    
Loop
End With



Do
    
    productNum = inv.Range("A" & invI).Value
    
    Do Until source.Range("A" & sourceI).Value = ""
    
       If productNum = source.Range("I" & sourceI).Value Then
        
            Select Case source.Range("A" & sourceI).Value
            Case Is = 10
                inv.Range("C" & invI) = source.Range("D" & sourceI).Value
                inv.Range("D" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 12
                inv.Range("E" & invI) = source.Range("D" & sourceI).Value
                inv.Range("F" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 13
                inv.Range("G" & invI) = source.Range("D" & sourceI).Value
                inv.Range("H" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 14
                inv.Range("I" & invI) = source.Range("D" & sourceI).Value
                inv.Range("J" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 15
                inv.Range("K" & invI) = source.Range("D" & sourceI).Value
                inv.Range("L" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 16
                inv.Range("M" & invI) = source.Range("D" & sourceI).Value
                inv.Range("N" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 20
                inv.Range("O" & invI) = source.Range("D" & sourceI).Value
                inv.Range("P" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 21
                inv.Range("Q" & invI) = source.Range("D" & sourceI).Value
                inv.Range("R" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 30
                inv.Range("S" & invI) = source.Range("D" & sourceI).Value
                inv.Range("T" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 31
                inv.Range("U" & invI) = source.Range("D" & sourceI).Value
                inv.Range("V" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 32
                inv.Range("W" & invI) = source.Range("D" & sourceI).Value
                inv.Range("X" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 40
                inv.Range("Y" & invI) = source.Range("D" & sourceI).Value
                inv.Range("Z" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 41
                inv.Range("AA" & invI) = source.Range("D" & sourceI).Value
                inv.Range("AB" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 51
                inv.Range("AC" & invI) = source.Range("D" & sourceI).Value
                inv.Range("AD" & invI) = source.Range("C" & sourceI).Value
            
            End Select
            
            sourceI = sourceI + 1
            
        End If
        
        invI = invI + 1
        
    Loop
    
Loop Until productNum = "end"


End Sub

非常感谢任何帮助。

Answer 1

如果这一行returns为真Do Until source.Range("A" & sourceI).Value = ""

你永远不会增加 invI = invI + 1

这会导致您进入无限循环。

将增量器移至 Loop

之后

            End Select
            
            sourceI = sourceI + 1
            
        End If
    Loop
    invI = invI + 1
    
Loop Until productNum = "end"

使用 for 循环，您的代码将是：

    Dim inv As Worksheet
    Dim source As Worksheet
    Dim productNum As String
    Dim invI As Long
    Dim sourceI As Long
    Dim i As Long
    Dim j As Long
    Dim lr As Long
    
    Set inv = ThisWorkbook.Sheets("Inventory")
    Set source = ThisWorkbook.Sheets("Input")
    
    With inv
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(3, 3), .Cells(lr, 30)).Value = 0 'No need to loop you can assign all at once
        
        For i = 3 To lr
            productNum = .Cells(i, 3).Value
            For j = 2 To source.Cells(Rows.Count, 1).End(xlUp).Row
                If productNum = source.Cells(j, 9).Value Then
                    Select Case source.Cells(j, 1).Value
                    'You can shorten this by doing an offset of source.Cells(j, 1).Value to get the column
                    'It will make debugging harder but the code shorter
                        Case 10
                            inv.Range("C" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("D" & invI) = source.Range("C" & sourceI).Value
                        Case 12
                            inv.Range("E" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("F" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 13
                            inv.Range("G" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("H" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 14
                            inv.Range("I" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("J" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 15
                            inv.Range("K" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("L" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 16
                            inv.Range("M" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("N" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 20
                            inv.Range("O" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("P" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 21
                            inv.Range("Q" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("R" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 30
                            inv.Range("S" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("T" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 31
                            inv.Range("U" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("V" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 32
                            inv.Range("W" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("X" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 40
                            inv.Range("Y" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("Z" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 41
                            inv.Range("AA" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("AB" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 51
                            inv.Range("AC" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("AD" & invI) = source.Range("C" & sourceI).Value
                        
                    End Select
                End If
            Next j
        Next i
    End With

我的 VBA 宏在更改一个单元格后崩溃

My VBA Macro crashes after changing one cell

excel

vba