Excel VBA问卷问题ID与选项ID自动生成需求求助

以下是完善后的代码，完全满足你生成U列（Single Question Code）和AX列（Option Code）的需求：

Sub Qest()
    Dim Ssh As Worksheet, Tsh As Worksheet
    Dim k As Long, lastquest As Long, i As Long, j As Long
    Dim answerarray As Variant
    Dim singleQCode As String
    
    Set Ssh = Worksheets("NA")
    Set Tsh = Worksheets("NA2")
    k = 3
    lastquest = Ssh.Range("D" & Rows.Count).End(xlUp).Row
    
    For i = 2 To lastquest
        ' 处理空选项的情况，避免Split返回异常
        If Trim(Ssh.Cells(i, 5).Value) = "" Then
            answerarray = Array("")
        Else
            answerarray = Split(Ssh.Cells(i, 5), ", ")
        End If
        
        ' 生成唯一的Single Question Code：问卷编码 + 问题序号（基于源表行号）
        singleQCode = Ssh.Cells(i, "F").Value & "-Q" & (i - 1)
        
        For j = 0 To UBound(answerarray)
            ' 原有逻辑：填充A列和T列
            Tsh.Cells(k, "A") = Ssh.Cells(i, "D")
            Tsh.Cells(k, "T") = Ssh.Cells(i, "F")
            
            ' 填充U列：所有选项行复用当前问题的唯一编码
            Tsh.Cells(k, "U") = singleQCode
            
            ' 填充AX列：仅多选题（选项数≥2）且选项非空时生成专属编码
            If UBound(answerarray) > 0 And Trim(answerarray(j)) <> "" Then
                Tsh.Cells(k, "AX") = singleQCode & "-O" & (j + 1)
            Else
                Tsh.Cells(k, "AX") = "" ' 无选项/单选题时留空
            End If
            
            k = k + 1
        Next j
    Next i
End Sub

关键逻辑说明 #

• Single Question Code（U列）：
  采用「问卷编码（F列）-Q-问题序号」的格式，其中问题序号用源表行号偏移（i-1）保证唯一性，同一个问题的所有选项行将复用该编码。如果你有自定义的问题编号（比如源表某列存问题ID），可直接替换(i-1)为对应单元格的值，例如Ssh.Cells(i, "C").Value。

• Option Code（AX列）：
  仅当问题为多选题（拆分后选项数量≥2）且当前选项不为空时生成，格式为「Single Question Code-O-选项序号」，选项序号从1开始递增。若为单选题（仅1个选项）或无预设选项（E列为空），则AX列留空。

• 空选项处理：
  专门判断源表E列（选项列）为空的情况，确保开放式问题也能生成对应的Single Question Code，同时AX列保持空白。

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