VBA 格式问题导致编译错误

Question

我目前正在尝试格式化某人在上一个问题的评论中给我的代码块，但遇到了很多编译错误。

此回答的问题是昨天发布的，但由于某种原因关闭了。它的标题是：用于 Excel 的 Visual basic 宏，根据产品列的数量插入行[已关闭]

代码：

Sub ExpandRows()

Dim lastRow As Long
Dim i As Long
Dim qty As Long
Dim productType As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'Insert here your worksheet name
' Assuming data starts from row 2
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For i = lastRow To 2 Step -1
qty = ws.Cells(i, 1).Value
productType = ws.Cells(i, 2).Value
' Insert rows and fill with product type
If qty > 1 Then Rows(i + 1 & ":" & i + qty - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(i, 2), Cells(i + qty - 1, 2)).Value = productType
End If
Next i


End Sub

我不知道在哪里插入换行符。 该代码应该在数量超过 1 的产品下插入行，然后复制产品的描述以填充插入行中的列。

感谢您的帮助！

我尝试以多种方式打破底部的行，但只是导致越来越多的编译错误，并且对 VBA 格式不太熟悉。

Answer 1

• 用数组转换数据效率更高。

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, k As Long
    Dim arrData, rngData As Range, arrRes
    arrData = ActiveSheet.Range("A1").CurrentRegion.Value
    ReDim arrRes(1 To Application.Sum(Range("a:a")), 1 To UBound(arrData, 2))
    k = 1
    For i = LBound(arrData) + 1 To UBound(arrData)
        For j = 1 To arrData(i, 1)
            If j = 1 Then arrRes(k, 1) = arrData(i, 1)
            arrRes(k, 2) = arrData(i, 2)
            k = k + 1
        Next j
    Next i
    Range("A2").Resize(k - 1, 2).Value = arrRes
End Sub