请求编写VBA实现Excel多选项答案拆分并新增行的数据迁移

以下是满足需求的VBA代码，直接在Excel中按Alt+F11打开VBA编辑器，插入模块后粘贴运行即可：

Sub SplitAnswersAndMigrate()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, targetRow As Long
    Dim questionText As String, answerText As String
    Dim answerArr As Variant
    Dim i As Integer, j As Integer
    
    ' 定义源工作表和目标工作表，名称不符可直接修改
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
    targetRow = 3 ' 目标数据起始行
    
    ' 遍历源数据行
    For i = 2 To lastRowSource
        questionText = wsSource.Cells(i, "D").Value
        answerText = wsSource.Cells(i, "E").Value
        
        ' 按", "拆分多选项答案
        answerArr = Split(answerText, ", ")
        
        ' 逐行写入目标表，重复对应问题
        For j = LBound(answerArr) To UBound(answerArr)
            wsTarget.Cells(targetRow, "A").Value = questionText
            wsTarget.Cells(targetRow, "AX").Value = answerArr(j)
            targetRow = targetRow + 1
        Next j
    Next i
    
    MsgBox "数据迁移完成！"
End Sub

代码说明 #

• 自动遍历源表D列（问题）和E列（答案），从第2行到数据最后一行
• 识别含", "的多选项答案，拆分后在目标表逐行写入
• 拆分出的每一行答案，A列自动重复对应问题文本
• 目标数据从Sheet2的A3和AX3位置开始写入，无需手动提前插行

使用注意事项 #

• 运行前确认源表、目标表名称与代码中的Sheet1、Sheet2一致，不一致直接修改代码内的工作表名称
• 源数据行数若不是889行，代码会自动识别D列最后一行数据，无需手动调整行数

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