|  | 
 
 发表于 2024-7-23 17:11:11
|
显示全部楼层
   本楼为最佳答案 
| 
 很抱歉之前的实现未能满足您的需求,现在我们将明确处理 `C` 列中的 `\` 和 `,` 分隔符。以下是修正后的代码,确保对这两个字符的处理:
 
 
 复制代码Sub MacroForDataExpansion()
    Dim wsExpand As Worksheet
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim arrData As Variant
    Dim strTemp As String
    Dim maxColumns As Long
    Dim regex As Object
    Dim match As Object
    Dim regexPattern As String
    ' 设置源工作表
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    ' 检查是否存在“展开表”
    On Error Resume Next
    Set wsExpand = ThisWorkbook.Sheets("展开表")
    On Error GoTo 0
    If Not wsExpand Is Nothing Then
        ' 如果存在,清空内容
        wsExpand.Cells.Clear
    Else
        ' 如果不存在,创建新工作表
        Set wsExpand = ThisWorkbook.Sheets.Add
        wsExpand.Name = "展开表"
    End If
    ' 复制A列和B列
    wsSource.Range("A:A").Copy wsExpand.Range("A1")
    wsSource.Range("B:B").Copy wsExpand.Range("B1")
    ' 找到最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    maxColumns = 0
    ' 初始化正则表达式
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    ' 处理C列数据
    For i = 1 To lastRow
        strTemp = wsSource.Cells(i, 3).Value
        
        ' 将“\”和“,”替换为“|”
        strTemp = Replace(strTemp, "", "|")
        strTemp = Replace(strTemp, ",", "|")
        
        ' 使用“|”分割字符串
        arrData = Split(strTemp, "|")
        
        Dim numSegments As Long
        numSegments = UBound(arrData) + 1 ' 得到分割后数组的长度
        
        ' 更新最大列数
        If numSegments > maxColumns Then maxColumns = numSegments
        
        ' 填充分割后的内容到“展开表”的C列及之后的单元格
        For j = 0 To UBound(arrData)
            wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
        Next j
        
        ' 使用正则表达式匹配形式为"\d+x\d+x\d+"的字符串
        regexPattern = "\d+x\d+x\d+" ' 匹配模式
        If regex.Test(strTemp) Then
            Set match = regex.Execute(strTemp)
            wsExpand.Cells(i, 3 + numSegments).Value = match(0) ' 在分割后的最后一列后添加匹配项
        End If
    Next i
    ' 复制D列到J列的内容
    For j = 4 To 10 ' D到J列
        wsSource.Range(wsSource.Cells(1, j), wsSource.Cells(lastRow, j)).Copy wsExpand.Cells(1, maxColumns + 4)
    Next j
    ' 调整列宽
    wsExpand.Columns.AutoFit
End Sub
 ### 更新说明:
 1. **分隔符替换**:将 `\` 和 `,` 替换为 `|`,这样可以同时处理两个字符。
 2. **分割逻辑**:使用 `Split` 函数根据 `|` 分割字符串,确保内容能正确拆分成若干段。
 3. **正则表达式匹配**:会检查 `C` 列的内容是否匹配 `\d+x\d+x\d+` 模式,并将匹配项放在分割结果的最后一列后面。
 
 请您再次尝试运行这个版本的代码,看看能否达到预期效果!如您还有其他问题,请随时告知,我们一起解决!谢谢您的理解与支持!
 
 以上回复来自 FishC AI 小助理,如未能正确解答您的问题,请继续追问。
 | 
 |