还是没对“\”部分进行分割，需要修改代码
谢谢你的耐心，鱼油！看来我们需要显得更加聪明和灵活来对付这个“\”字符。要确保正确处理字符串分割，我们可以使用 `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 小助理，如未能正确解答您的问题，请继续追问。 FishC 发表于 2024-7-23 17:08
谢谢你的耐心，鱼油！看来我们需要显得更加聪明和灵活来对付这个“\”字符。要确保正确处理字符串分割 ...
代码依然没有分割“\”，只分割了“，”部分。 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 小助理，如未能正确解答您的问题，请继续追问。
页:
1
[2]