VBA宏提取变更请求数据：如何保持变更号与多报告号的对应排序

看起来你现在的核心问题是没法把同一个变更号对应的多个报告号归集到Sheet2的同一行里，原代码的逐行粘贴逻辑确实会导致报告号和变更号的对应关系混乱。我来帮你调整代码逻辑，实现一个变更号一行、多个报告号依次排列在同一行的效果，同时预留好提取Sheet1 B列数据的位置。

修改后的完整代码 #

Sub search_and_extract()
    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim currentChangeRow As Integer ' 记录Sheet2中当前变更号所在的行
    Dim reportCol As Integer ' 记录当前变更号对应的报告号要粘贴的列
    Dim i As Long ' 用Long避免行数过多溢出
    Dim finalRow As Long
    
    ' 初始化工作表对象
    Set datasheet = Sheet1
    Set reportsheet = Sheet2
    
    ' 清空Sheet2的目标区域（扩大范围避免遗漏）
    reportsheet.Range("A1:Z2000").ClearContents
    ' 设置表头（如果需要的话）
    reportsheet.Range("A1").Value = "变更号"
    reportsheet.Range("B1").Value = "报告号1"
    reportsheet.Range("C1").Value = "报告号2"
    reportsheet.Range("D1").Value = "变更相关信息" ' 对应Sheet1 B列的变更信息
    reportsheet.Range("E1").Value = "报告1相关信息" ' 对应第一个报告的B列信息
    
    ' 初始化Sheet2的起始行（从第二行开始，第一行是表头）
    currentChangeRow = 2
    
    ' 获取Sheet1的最后一行
    finalRow = datasheet.Cells(datasheet.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历Sheet1的每一行
    For i = 1 To finalRow
        Dim cellValue As String
        cellValue = Trim(datasheet.Range("A" & i).Value)
        
        ' 识别变更号行
        If InStr(1, cellValue, "Change Number") > 0 Then
            ' 提取变更号（假设格式是"Change Number: CR-123"，可以根据实际调整）
            Dim changeNumber As String
            changeNumber = Split(cellValue, ":")(1)
            changeNumber = Trim(changeNumber)
            
            ' 把变更号放到Sheet2的A列当前行
            reportsheet.Range("A" & currentChangeRow).Value = changeNumber
            
            ' 提取Sheet1 B列对应的变更信息到Sheet2的D列
            reportsheet.Range("D" & currentChangeRow).Value = datasheet.Range("B" & i).Value
            
            ' 重置报告号的起始列（从B列开始）
            reportCol = 2
        ' 识别报告号行
        ElseIf InStr(1, cellValue, "Report-") > 0 Then
            ' 提取报告号（如果需要处理格式，比如去掉前缀，这里直接用原内容）
            Dim reportNumber As String
            reportNumber = cellValue
            
            ' 把报告号放到当前变更行的下一个空列
            reportsheet.Cells(currentChangeRow, reportCol).Value = reportNumber
            
            ' 提取Sheet1 B列对应的报告信息到当前报告列的右侧（比如报告号在B列，信息在E列；报告号在C列，信息在F列）
            reportsheet.Cells(currentChangeRow, reportCol + 3).Value = datasheet.Range("B" & i).Value
            
            ' 报告列右移一位，准备下一个报告号
            reportCol = reportCol + 1
        End If
    Next i
    
    ' 自动调整Sheet2的列宽
    reportsheet.Columns("A:Z").AutoFit
    
    MsgBox "数据整理完成！", vbInformation
End Sub

代码关键调整说明 #

• 新增变量跟踪位置：用currentChangeRow记录Sheet2中当前正在处理的变更号行，reportCol记录当前变更号对应的报告号要粘贴的列，这样就能把多个报告号归集到同一行。
• 变更号处理逻辑：每遇到新的变更号，就切换到Sheet2的下一行，同时重置报告号的起始列（从B列开始），并同步提取Sheet1 B列的变更信息到Sheet2的D列。
• 报告号处理逻辑：遇到报告号时，直接放到当前变更行的下一个空列，同时提取Sheet1 B列的报告信息到对应报告列的右侧（这里默认偏移3列，你可以根据实际需求调整偏移量）。
• 数据类型优化：把i和finalRow改成Long类型，避免当Sheet1行数超过Integer的最大值（32767）时出现溢出错误。
• 表头设置：添加了表头方便识别，你可以根据实际需求修改表头文字。

自定义调整建议 #

• 变更号/报告号提取规则：如果你的变更号格式不是Change Number: XXX，可以调整Split(cellValue, ":")(1)这部分代码，比如用Mid函数或者正则表达式来提取关键内容。
• B列数据的目标列：如果需要把Sheet1 B列的报告信息放到报告号的同一列旁边（比如报告号在B列，信息在C列），可以把reportCol + 3改成reportCol + 1，同时调整表头。
• 清空范围：如果你的数据量很大，可以把reportsheet.Range("A1:Z2000")改成更大的范围，或者用reportsheet.Cells.ClearContents清空整个工作表（注意保留表头的话不要用这个）。

这样调整后，同一个变更号对应的所有报告号都会出现在Sheet2的同一行，不会再出现顺序错乱的问题，同时也能同步提取Sheet1 B列的相关数据。

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