基于奖品细分表填充VBA新增行的技术咨询

安全阿岳

2026-6-18

奖品拆分需求与现有实现问题

我需要定期生成一个.csv文件，文件包含带总价值的父奖品，以及基于细分表与父奖品金额匹配的子奖品。目前已实现根据所需子奖品数量新增行，但无法基于细分表填充这些行的数据。现在细分值放在Description列（F列），不确定这是不是让VBA识别需添加子奖品的最优方式。

父奖品列表示例

细分值表格示例

提取细分信息的公式（L列）

=TRIM(IF(ISBLANK(B2),"",$B$1&"x"&B2)&" "&IF(ISBLANK(C2),"",$C$1&"x"&C2)&" "&IF(ISBLANK(D2),"",$D$1&"x"&D2)&" "&IF(ISBLANK(E2),"",$E$1&"x"&E2)&" "&IF(ISBLANK(F2),"",$F$1&"x"&F2)&" "&IF(ISBLANK(G2),"",$G$1&"x"&G2)&" "&IF(ISBLANK(H2),"",$H$1&"x"&H2)&" "&IF(ISBLANK(I2),"",$I$1&"x"&I2)&" "&IF(ISBLANK(J2),"",$J$1&"x"&J2))

待填充的子奖品示例

新增行的VBA代码

Sub InsertRowsIf()
Dim lr As Long, R As Range, i As Long
lr = Range("G" & Rows.Count).End(xlUp).Row
Set R = Range("G1", "G" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count To 1 Step -1
    If IsNumeric(R.Cells(i, 1).Value) And Not IsEmpty(R.Cells(i, 1)) Then
        R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Value).EntireRow.Insert
    End If
Next i
Application.ScreenUpdating = True
End Sub