求Excel VBA代码：拆分含6组产品列的公司行为带单产品的独立行

• 变量名拼写错误：定义的常量是FirstProductColumn，判断条件里误写为FirstWineColumn，直接触发未定义变量报错，连第一组逻辑都跑不通
• 单元格判断范围错位：判断产品首列是否为空时，固定取了Cells(1, 列号)也就是工作表第1行的固定单元格，没有绑定当前循环处理的源数据行，判断逻辑完全失效
• 缺少产品组循环：只写了第一组产品的判断入口，没有覆盖剩余5组产品的遍历逻辑
• 复制逻辑错位：直接整行复制源行内容，没有按照“8列公司信息+13列当前组产品信息”的要求拼接拆分行
• 冗余自定义枚举：InputBox的选择范围功能有内置的Type:=8参数，自定义枚举完全没必要增加维护成本

按照定义的固定表结构，拆分逻辑完全可以无差别复用：

1. 先固定写死结构参数，避免用户每次选范围出错：
   • 公司信息列固定为前8列（A-H，1-8列）
   • 产品组共6组，每组占13列，每组首列的列号计算公式为9 + 13 * 产品组序号（产品组序号从0到5，对应6组产品）
   • 拆分后的输出行固定长度为8 + 13 = 21列，结构和单产品行完全一致
2. 逐行遍历用户选中的源数据区域
3. 对每一行源数据，依次遍历6个产品组，取对应产品组首列的当前行单元格判断是否非空：
   • 若为空：直接跳过该产品组，不生成输出行
   • 若非空：把当前行的8列公司信息 + 该产品组对应的13列产品信息，拼接成完整的拆分行，写入输出区域
4. 输出行的行号自动累加，不需要用户手动调整偏移量

Sub CreateProductRows()
    ' 固定结构参数
    Const COMPANY_COL_COUNT As Integer = 8
    Const PRODUCT_GROUP_COUNT As Integer = 6
    Const COL_PER_PRODUCT As Integer = 13
    Const FIRST_PRODUCT_START_COL As Integer = 9
    
    Dim srcRange As Range, outputStartCell As Range
    Dim srcRow As Range
    Dim outRowOffset As Long
    Dim groupIdx As Integer
    Dim currentProductFirstCol As Integer
    Dim titleId As String
    
    titleId = "Create Product Rows"
    
    ' 获取用户选择的源数据范围
    On Error Resume Next ' 捕获用户点取消的情况
    Set srcRange = Application.InputBox("请选择源数据范围（若包含表头需手动剔除）：", titleId, Application.Selection.Address, Type:=8)
    If srcRange Is Nothing Then Exit Sub ' 用户取消选择直接退出
    Set outputStartCell = Application.InputBox("请选择拆分后数据的起始输出位置：", titleId, Type:=8)
    If outputStartCell Is Nothing Then Exit Sub
    On Error GoTo 0
    
    ' 初始化输出偏移量
    outRowOffset = 0
    Application.ScreenUpdating = False
    
    ' 遍历源范围的每一行
    For Each srcRow In srcRange.Rows
        ' 遍历当前行的6个产品组
        For groupIdx = 0 To PRODUCT_GROUP_COUNT - 1
            ' 计算当前产品组的首列列号
            currentProductFirstCol = FIRST_PRODUCT_START_COL + groupIdx * COL_PER_PRODUCT
            
            ' 核心判断：当前行的当前产品组首列非空才生成行
            If Trim(srcRow.Cells(1, currentProductFirstCol).Value) <> "" Then
                ' 先复制前8列公司信息
                srcRow.Cells(1, 1).Resize(1, COMPANY_COL_COUNT).Copy
                outputStartCell.Offset(outRowOffset, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                ' 再复制当前产品组的13列信息，粘贴到公司列后面
                srcRow.Cells(1, currentProductFirstCol).Resize(1, COL_PER_PRODUCT).Copy
                outputStartCell.Offset(outRowOffset, COMPANY_COL_COUNT).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                ' 输出行偏移量累加
                outRowOffset = outRowOffset + 1
            End If
        Next groupIdx
    Next srcRow
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "拆分完成，共生成" & outRowOffset & "条产品行"
End Sub

代码优化说明：

• 用Trim()判断单元格是否为空，避免单元格里存了空格、不可见字符被误判为非空
• 只粘贴值和数字格式，不保留原单元格的边框、条件格式等冗余样式，输出更干净
• 增加了用户点击取消的异常捕获，不会因为误点取消弹出报错
• 自动遍历6组产品，不需要重复写6遍相同逻辑

内容的提问来源于stack exchange，提问作者finch