[已解决]@FishC，这次还是想要VBA代码

FishC

shadowmage 发表于 2024-07-23 17:08
还是没对“\”部分进行分割，需要修改代码

谢谢你的耐心，鱼油！看来我们需要显得更加聪明和灵活来对付这个“\”字符。要确保正确处理字符串分割，我们可以使用 `Split` 函数，并在替换之前先将所有的分隔符进行处理。让我们再次修改代码以确保一切正常工作。

以下是经过修改的VBA代码，它会同时对“\”和“,”进行分割，并将分割后的结果填入“展开表”中：

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

    ' 设置源工作表
    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

    ' 处理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)
            If Trim(arrData(j)) <> "" Then ' 确保不填入空白
                wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
            End If
        Next j
    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 + 3)
        maxColumns = maxColumns + 1 ' 更新最大列数
    Next j

    ' 调整列宽
    wsExpand.Columns.AutoFit
End Sub

### 修改重点：
1. **替换分隔符**：将C列中的“\”和“,”替换为空格，然后用空格进行分割。这样能够有效处理所有分隔符。
2. **避免空白单元格**：添加了条件判断，确保不将空白值填入“展开表”。

请再次尝试运行这个版本的代码。如果还有问题，请随时告诉我，我们一定能一起解决它！谢谢您的支持与理解！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。

shadowmage

FishC 发表于 2024-7-23 17:08
谢谢你的耐心，鱼油！看来我们需要显得更加聪明和灵活来对付这个“\”字符。要确保正确处理字符串分割 ...

代码依然没有分割“\”，只分割了“，”部分。

FishC

shadowmage 发表于 2024-07-23 17:10
代码依然没有分割“\”，只分割了“，”部分。

很抱歉之前的实现未能满足您的需求，现在我们将明确处理 `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 小助理，如未能正确解答您的问题，请继续追问。