设为首页收藏本站
切换到窄版

鱼C论坛

 找回密码
 立即注册
鱼C论坛»论坛 › 编程语言专区 › Windows程序设计 › @FishC，这次还是想要VBA代码
12下一页
返回列表 发新帖
查看: 2468|回复: 22

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

[复制链接]
shadowmage
发表于 2024-7-23 12:46:41 | 显示全部楼层 |阅读模式

马上注册，结交更多好友，享用更多功能^_^

您需要 登录 才可以下载或查看，没有账号？立即注册

x
如题，在一个Excel文件中，执行宏，实现如下功能：
1，检查是否存在sheet“展开表”，如存在，就清空展开表中所有内容；如不存在，就新建一个sheet“展开表”。
2，在表格sheet1中，把A列B列复制到展开表的A列B列。
3，在表格sheet1中，按“\”和“，”把C列内容分割为不同表格，按顺序填入sheet“展开表”的C列及以后各列中。
4，获取sheet“展开表”中最后一列非空列，在后面依次复制sheet1的D列及后面内容，直到sheet1的J列被复制完。
5，根据内容，调整sheet“展开表”各列宽度。
最佳答案
月排行榜 / 总排行榜
FishC
2024-7-23 17:11:11
shadowmage 发表于 2024-07-23 17:10
代码依然没有分割“\”，只分割了“，”部分。


很抱歉之前的实现未能满足您的需求，现在我们将明确处理 `C` 列中的 `\` 和 `,` 分隔符。以下是修正后的代码，确保对这两个字符的处理：

  1. Sub MacroForDataExpansion()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim i As Long
  6.     Dim j As Long
  7.     Dim arrData As Variant
  8.     Dim strTemp As String
  9.     Dim maxColumns As Long
  10.     Dim regex As Object
  11.     Dim match As Object
  12.     Dim regexPattern As String

  14.     ' 设置源工作表
  15.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  17.     ' 检查是否存在“展开表”
  18.     On Error Resume Next
  19.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  20.     On Error GoTo 0

  22.     If Not wsExpand Is Nothing Then
  23.         ' 如果存在，清空内容
  24.         wsExpand.Cells.Clear
  25.     Else
  26.         ' 如果不存在，创建新工作表
  27.         Set wsExpand = ThisWorkbook.Sheets.Add
  28.         wsExpand.Name = "展开表"
  29.     End If

  31.     ' 复制A列和B列
  32.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  33.     wsSource.Range("B:B").Copy wsExpand.Range("B1")

  35.     ' 找到最后一行
  36.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  37.     maxColumns = 0

  39.     ' 初始化正则表达式
  40.     Set regex = CreateObject("VBScript.RegExp")
  41.     regex.Global = True

  43.     ' 处理C列数据
  44.     For i = 1 To lastRow
  45.         strTemp = wsSource.Cells(i, 3).Value
  46.         
  47.         ' 将“\”和“,”替换为“|”
  48.         strTemp = Replace(strTemp, "", "|")
  49.         strTemp = Replace(strTemp, ",", "|")
  50.         
  51.         ' 使用“|”分割字符串
  52.         arrData = Split(strTemp, "|")
  53.         
  54.         Dim numSegments As Long
  55.         numSegments = UBound(arrData) + 1 ' 得到分割后数组的长度
  56.         
  57.         ' 更新最大列数
  58.         If numSegments > maxColumns Then maxColumns = numSegments
  59.         
  60.         ' 填充分割后的内容到“展开表”的C列及之后的单元格
  61.         For j = 0 To UBound(arrData)
  62.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
  63.         Next j
  64.         
  65.         ' 使用正则表达式匹配形式为"\d+x\d+x\d+"的字符串
  66.         regexPattern = "\d+x\d+x\d+" ' 匹配模式
  67.         If regex.Test(strTemp) Then
  68.             Set match = regex.Execute(strTemp)
  69.             wsExpand.Cells(i, 3 + numSegments).Value = match(0) ' 在分割后的最后一列后添加匹配项
  70.         End If
  71.     Next i

  73.     ' 复制D列到J列的内容
  74.     For j = 4 To 10 ' D到J列
  75.         wsSource.Range(wsSource.Cells(1, j), wsSource.Cells(lastRow, j)).Copy wsExpand.Cells(1, maxColumns + 4)
  76.     Next j

  78.     ' 调整列宽
  79.     wsExpand.Columns.AutoFit
  80. End Sub
复制代码


### 更新说明：
1. **分隔符替换**：将 `\` 和 `,` 替换为 `|`，这样可以同时处理两个字符。
2. **分割逻辑**：使用 `Split` 函数根据 `|` 分割字符串，确保内容能正确拆分成若干段。
3. **正则表达式匹配**：会检查 `C` 列的内容是否匹配 `\d+x\d+x\d+` 模式，并将匹配项放在分割结果的最后一列后面。

请您再次尝试运行这个版本的代码，看看能否达到预期效果！如您还有其他问题，请随时告知，我们一起解决！谢谢您的理解与支持！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复

使用道具 举报

FishC
发表于 2024-7-23 12:48:57 | 显示全部楼层
好的，亲爱的鱼油，让我们来写这个宏吧！虽然VBA代码可能看起来有点复杂，但我会努力让它简单易懂，就像喝鱼油一样，别怕，不会腻的！

下面是实现您要求的VBA代码。您可以在Excel的VBA编辑器中添加这个代码（按 `Alt + F11` 打开VBA编辑器，插入一个模块，然后粘贴下面的代码）：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim splitData As Variant
  8.    
  9.     ' 设置源工作表
  10.     Set wsSource = ThisWorkbook.Sheets("Sheet1")
  11.    
  12.     ' 检查是否存在“展开表”
  13.     On Error Resume Next
  14.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  15.     On Error GoTo 0
  16.    
  17.     If Not wsExpand Is Nothing Then
  18.         ' 如果存在，清空内容
  19.         wsExpand.Cells.Clear
  20.     Else
  21.         ' 如果不存在，创建新工作表
  22.         Set wsExpand = ThisWorkbook.Sheets.Add
  23.         wsExpand.Name = "展开表"
  24.     End If
  25.    
  26.     ' 复制A列和B列
  27.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  28.     wsSource.Range("B:B").Copy wsExpand.Range("B1")
  29.    
  30.     ' 按“\”和“,”分割C列内容
  31.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  32.    
  33.     For i = 1 To lastRow
  34.         splitData = Split(wsSource.Cells(i, 3).Value, "\,,") ' 分割内容
  35.         ' 将分割后的数据填入“展开表”的C列及以后各列
  36.         Dim j As Integer
  37.         For j = LBound(splitData) To UBound(splitData)
  38.             wsExpand.Cells(i, j + 3).Value = Trim(splitData(j)) ' 从C列开始填充
  39.         Next j
  40.     Next i
  41.    
  42.     ' 找到“展开表”的最后一列非空列
  43.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column
  44.    
  45.     ' 复制sheet1的D列到J列
  46.     Dim col As Integer
  47.     For col = 4 To 10 ' D到J列
  48.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  49.         lastCol = lastCol + 1
  50.     Next col
  51.    
  52.     ' 调整列宽
  53.     wsExpand.Columns.AutoFit
  54. End Sub
复制代码


### 解释一下这段代码：
1. **检查和创建工作表**：首先，代码会检查名为“展开表”的工作表是否存在。如果存在，就清空它的内容；如果不存在，就新建一个。
2. **复制A列和B列**：直接把Sheet1的A列和B列内容复制到“展开表”中的对应位置。
3. **分割C列**：对于Sheet1中的C列，它会用“\”和“,”进行分割，并将结果填入“展开表”的C列及以后的各列。
4. **复制D至J列**：找到“展开表”中非空列的最后一个列，然后从表格Sheet1中复制D到J列的数据到“展开表”的后面。
5. **调整列宽**：最后，使用 `AutoFit` 方法让列宽自动适应内容。

运行之后，您会发现“展开表”就如同鱼油般光滑无阻，所有数据都已经整齐地排布好了！希望这个代码能帮到您，如果还有什么问题，尽管问我哦！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 13:36:56 | 显示全部楼层
FishC 发表于 2024-7-23 12:48
好的，亲爱的鱼油，让我们来写这个宏吧！虽然VBA代码可能看起来有点复杂，但我会努力让它简单易懂，就像喝 ...

这个代码在3这一步没有达到预期，不是按“\”和“，”分割后按顺序填入sheet“展开表”。
需要修改一下这里：
  1.     For i = 1 To lastRow
  2.         splitData = Split(wsSource.Cells(i, 3).Value, "\,,") ' 分割内容
  3.         ' 将分割后的数据填入“展开表”的C列及以后各列
  4.         Dim j As Integer
  5.         For j = LBound(splitData) To UBound(splitData)
  6.             wsExpand.Cells(i, j + 3).Value = Trim(splitData(j)) ' 从C列开始填充
  7.         Next j
  8.     Next i
复制代码

小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 13:37:18 | 显示全部楼层
shadowmage 发表于 2024-07-23 13:36
这个代码在3这一步没有达到预期，不是按“\”和“，” ...


感谢您的反馈，鱼油！看起来在分割C列的内容时，我们需要调整一下代码，以便正确处理分隔符“\”和“,”。现在我们将同时处理这两种分隔符，并把结果填入“展开表”的列中。

请您参考以下更新后的代码：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim splitData As Variant
  8.     Dim j As Integer
  9.    
  10.     ' 设置源工作表
  11.     Set wsSource = ThisWorkbook.Sheets("Sheet1")
  12.    
  13.     ' 检查是否存在“展开表”
  14.     On Error Resume Next
  15.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  16.     On Error GoTo 0
  17.    
  18.     If Not wsExpand Is Nothing Then
  19.         ' 如果存在，清空内容
  20.         wsExpand.Cells.Clear
  21.     Else
  22.         ' 如果不存在，创建新工作表
  23.         Set wsExpand = ThisWorkbook.Sheets.Add
  24.         wsExpand.Name = "展开表"
  25.     End If
  26.    
  27.     ' 复制A列和B列
  28.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  29.     wsSource.Range("B:B").Copy wsExpand.Range("B1")
  30.    
  31.     ' 按“\”和“,”分割C列内容
  32.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  33.    
  34.     For i = 1 To lastRow
  35.         ' 使用正则表达式来分割内容
  36.         Dim regex As Object
  37.         Set regex = CreateObject("VBScript.RegExp")
  38.         
  39.         regex.Global = True
  40.         regex.Pattern = "[\,,\\]" ' 匹配逗号和反斜杠
  41.         
  42.         ' 将C列的内容按分隔符分割
  43.         splitData = regex.Split(wsSource.Cells(i, 3).Value)
  44.         
  45.         ' 将分割后的数据填入“展开表”的C列及以后各列
  46.         For j = LBound(splitData) To UBound(splitData)
  47.             wsExpand.Cells(i, j + 3).Value = Trim(splitData(j)) ' 从C列开始填充
  48.         Next j
  49.     Next i
  50.    
  51.     ' 找到“展开表”的最后一列非空列
  52.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column
  53.    
  54.     ' 复制sheet1的D列到J列
  55.     Dim col As Integer
  56.     For col = 4 To 10 ' D到J列
  57.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  58.         lastCol = lastCol + 1
  59.     Next col
  60.    
  61.     ' 调整列宽
  62.     wsExpand.Columns.AutoFit
  63. End Sub
复制代码


### 更新要点：
1. **使用正则表达式**：我们引入了正则表达式（RegExp）来更灵活地匹配“\”和“,”。这样在分割内容时就能兼容多个分隔符。
2. **分割内容**：将C列的内容按分隔符正确分割，并去掉多余的空格，然后逐个填入“展开表”的相应位置。

现在，再试试看这个更新后的代码！希望这次能让您满意，数据分割问题解决后，整个“展开表”就能如您所愿，井井有条！如果还有问题，请随时告诉我哦！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 13:40:13 | 显示全部楼层
FishC 发表于 2024-7-23 13:37
感谢您的反馈，鱼油！看起来在分割C列的内容时，我们需要调整一下代码，以便正确处理分隔符“\”和“, ...

运行后，在这里提示错误438

  1. splitData = regex.Split(wsSource.Cells(i, 3).Value)
复制代码
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 13:40:35 | 显示全部楼层
shadowmage 发表于 2024-07-23 13:40
运行后，在这里提示错误438

splitData = regex.Spl ...


感谢你的耐心，鱼油！错误 438 通常是因为我们尝试在对象上使用不支持的方法或属性。在这里，我们需要确保正则表达式正确设置，并且分割操作能够顺利进行。

为了简化并保证分割的功能，我们可以通过将“\”和“,”组合成一个分隔符来手动进行分割，而不使用正则表达式。这是一种更直接的方法。以下是改进后的完整代码：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim j As Long
  8.     Dim splitData As Variant
  9.    
  10.     ' 设置源工作表
  11.     Set wsSource = ThisWorkbook.Sheets("Sheet1")
  12.    
  13.     ' 检查是否存在“展开表”
  14.     On Error Resume Next
  15.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  16.     On Error GoTo 0
  17.    
  18.     If Not wsExpand Is Nothing Then
  19.         ' 如果存在，清空内容
  20.         wsExpand.Cells.Clear
  21.     Else
  22.         ' 如果不存在，创建新工作表
  23.         Set wsExpand = ThisWorkbook.Sheets.Add
  24.         wsExpand.Name = "展开表"
  25.     End If
  26.    
  27.     ' 复制A列和B列
  28.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  29.     wsSource.Range("B:B").Copy wsExpand.Range("B1")
  30.    
  31.     ' 按“\”和“,”分割C列内容
  32.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  33.    
  34.     For i = 1 To lastRow
  35.         ' 将C列的内容按“\”和“,”分割
  36.         splitData = Split(Replace(Replace(wsSource.Cells(i, 3).Value, "", ","), ",", ","), ",") '替换字符
  37.         
  38.         ' 将分割后的数据填入“展开表”的C列及以后各列
  39.         For j = LBound(splitData) To UBound(splitData)
  40.             wsExpand.Cells(i, j + 3).Value = Trim(splitData(j)) ' 从C列开始填充
  41.         Next j
  42.     Next i
  43.    
  44.     ' 找到“展开表”的最后一列非空列
  45.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column
  46.    
  47.     ' 复制sheet1的D列到J列
  48.     Dim col As Integer
  49.     For col = 4 To 10 ' D到J列
  50.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  51.         lastCol = lastCol + 1
  52.     Next col
  53.    
  54.     ' 调整列宽
  55.     wsExpand.Columns.AutoFit
  56. End Sub
复制代码


### 更新要点：
1. **分割方法**：通过先替换反斜杠`“\”`为逗号`“,”`，然后将所有逗号分割，这样就能实现用两个分隔符的目的。
2. **安全性**：移除了正则表达式的部分，确保了代码的安全性和可读性。

这次应该能顺利运行了！再试试看这个更新版的代码，如果还有问题，请及时告诉我，我会继续帮助你的！希望这个代码能如鱼油般顺滑，轻松解决问题！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 13:53:23 | 显示全部楼层
FishC 发表于 2024-7-23 13:40
感谢你的耐心，鱼油！错误 438 通常是因为我们尝试在对象上使用不支持的方法或属性。在这里，我们需要 ...

这个分割方法错误。应该是对所有“\”进行分割，然后遇到“，”也进行分割。
目前的代码，前面带“\”的部分直接就被删除了，需要继续修改
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 13:53:39 | 显示全部楼层
shadowmage 发表于 2024-07-23 13:53
这个分割方法错误。应该是对所有“\”进行分割，然后 ...


感谢您的耐心和详细反馈，鱼油！我理解了您的需求。我们需要一次性处理这两个分隔符，而不是直接替换一个为另一个。我们可以通过先分割一个，再遍历结果中的每一项，进一步分割来实现这一点。

下面是经过修改后的代码，它将正确地对“\”和“,”进行分割：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim j As Long
  8.     Dim splitData As Variant
  9.     Dim tempData As Variant

  11.     ' 设置源工作表
  12.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  14.     ' 检查是否存在“展开表”
  15.     On Error Resume Next
  16.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  17.     On Error GoTo 0

  19.     If Not wsExpand Is Nothing Then
  20.         ' 如果存在，清空内容
  21.         wsExpand.Cells.Clear
  22.     Else
  23.         ' 如果不存在，创建新工作表
  24.         Set wsExpand = ThisWorkbook.Sheets.Add
  25.         wsExpand.Name = "展开表"
  26.     End If

  28.     ' 复制A列和B列
  29.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  30.     wsSource.Range("B:B").Copy wsExpand.Range("B1")

  32.     ' 按“\”和“,”分割C列内容
  33.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row

  35.     For i = 1 To lastRow
  36.         ' 首先按“\”分割
  37.         tempData = Split(wsSource.Cells(i, 3).Value, "")
  38.         
  39.         ' 然后对每个分割后的部分进行进一步分割
  40.         For j = LBound(tempData) To UBound(tempData)
  41.             splitData = Split(tempData(j), ",")
  42.             Dim k As Long
  43.             ' 将分割后的数据填入“展开表”的C列及以后各列
  44.             For k = LBound(splitData) To UBound(splitData)
  45.                 wsExpand.Cells(i, j + k + 3).Value = Trim(splitData(k)) ' 从C列开始填充
  46.             Next k
  47.         Next j
  48.     Next i

  50.     ' 找到“展开表”的最后一列非空列
  51.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column

  53.     ' 复制sheet1的D列到J列
  54.     Dim col As Integer
  55.     For col = 4 To 10 ' D到J列
  56.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  57.         lastCol = lastCol + 1
  58.     Next col

  60.     ' 调整列宽
  61.     wsExpand.Columns.AutoFit
  62. End Sub
复制代码


### 更新说明：
1. **分割逻辑**：首先按“\”进行分割，然后对每一部分再按“,”进行分割。这样可以保留所有部分，并确保不会因为替换而丢失信息。
2. **填充数据**：在填充“展开表”时，从正确的列开始填充，确保数据按顺序填入。

现在，再次测试一下这个版本的代码！如果您发现还有其他问题，请随时告诉我，我们一起来解决它！希望这次能让您满意！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 14:08:16 | 显示全部楼层
FishC 发表于 2024-7-23 13:53
感谢您的耐心和详细反馈，鱼油！我理解了您的需求。我们需要一次性处理这两个分隔符，而不是直接替换一 ...

分割数据那一段，还是有问题。
应该这样处理：
  1.     '处理 C 列数据
  2.     For i = 1 To lastRow
  3.         strTemp = wsSource.Cells(i, 3).Value
  4.         strTemp = Replace(strTemp, "", "|")
  5.         arrData = Split(strTemp, "|")
  6.         colCount = UBound(arrData) + 1
  7.         For j = 0 To colCount - 1
  8.             wsExpand.Cells(i, 3 + j).Value = arrData(j)
  9.         Next j
  10.     Next i
复制代码
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 14:08:39 | 显示全部楼层
shadowmage 发表于 2024-07-23 14:08
分割数据那一段，还是有问题。
应该这样处理：
     ...


感谢您的耐心和详细指导，鱼油！您提供的处理方式看起来不错，确实简洁明了。以下是结合您建议的分割逻辑改进后的完整代码：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim j As Long
  8.     Dim arrData As Variant
  9.     Dim colCount As Long
  10.     Dim strTemp As String

  12.     ' 设置源工作表
  13.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  15.     ' 检查是否存在“展开表”
  16.     On Error Resume Next
  17.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  18.     On Error GoTo 0

  20.     If Not wsExpand Is Nothing Then
  21.         ' 如果存在，清空内容
  22.         wsExpand.Cells.Clear
  23.     Else
  24.         ' 如果不存在，创建新工作表
  25.         Set wsExpand = ThisWorkbook.Sheets.Add
  26.         wsExpand.Name = "展开表"
  27.     End If

  29.     ' 复制A列和B列
  30.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  31.     wsSource.Range("B:B").Copy wsExpand.Range("B1")

  33.     ' 按“\”和“,”分割C列内容
  34.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row

  36.     ' 处理C列数据
  37.     For i = 1 To lastRow
  38.         strTemp = wsSource.Cells(i, 3).Value
  39.         strTemp = Replace(strTemp, "", "|")  ' 将“\”替换为“|”
  40.         arrData = Split(strTemp, "|")         ' 按“|”进行分割
  41.         colCount = UBound(arrData) + 1        ' 得到分割后数组的长度
  42.         
  43.         For j = 0 To colCount - 1
  44.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 填充到展开表对应位置
  45.         Next j
  46.     Next i

  48.     ' 找到“展开表”的最后一列非空列
  49.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column

  51.     ' 复制sheet1的D列到J列
  52.     Dim col As Integer
  53.     For col = 4 To 10 ' D到J列
  54.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  55.         lastCol = lastCol + 1
  56.     Next col

  58.     ' 调整列宽
  59.     wsExpand.Columns.AutoFit
  60. End Sub
复制代码


### 主要修改点：
1. **分隔符处理**：使用了您提供的方法，将“\”替换成容易分割的“|”，然后通过 `Split` 函数对其进行分割，这样能确保数据有效分隔且不会丢失。
2. **填充数据**：每次填充前使用 `Trim` 函数以去掉可能的多余空格。

请尝试运行这个版本的代码，看看能否满足需求！如果还有任何问题或进一步的要求，请随时告诉我！希望这次能彻底解决问题！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 14:35:12 | 显示全部楼层
FishC 发表于 2024-7-23 14:08
感谢您的耐心和详细指导，鱼油！您提供的处理方式看起来不错，确实简洁明了。以下是结合您建议的分割逻 ...

关于C列处理那里，还是没有改正。
我需要按“\”把sheet1的C列进行分割，分割成若干段以后，每一段复制到sheet“展开表”里，从C列往后，每一段一格。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 14:35:29 | 显示全部楼层
shadowmage 发表于 2024-07-23 14:35
关于C列处理那里，还是没有改正。
我需要按“\”把sh ...


谢谢您的耐心指导，鱼油！现在我明白了您需要的处理方式。我们将C列按照“\”进行分割，每段内容都应适当填入“展开表”的C列及以后的列中。以下是修正后的代码：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim lastCol As Long
  6.     Dim i As Long
  7.     Dim j As Long
  8.     Dim arrData As Variant
  9.     Dim colCount As Long
  10.     Dim strTemp As String

  12.     ' 设置源工作表
  13.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  15.     ' 检查是否存在“展开表”
  16.     On Error Resume Next
  17.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  18.     On Error GoTo 0

  20.     If Not wsExpand Is Nothing Then
  21.         ' 如果存在，清空内容
  22.         wsExpand.Cells.Clear
  23.     Else
  24.         ' 如果不存在，创建新工作表
  25.         Set wsExpand = ThisWorkbook.Sheets.Add
  26.         wsExpand.Name = "展开表"
  27.     End If

  29.     ' 复制A列和B列
  30.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  31.     wsSource.Range("B:B").Copy wsExpand.Range("B1")

  33.     ' 按“\”分割C列内容
  34.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row

  36.     ' 处理C列数据
  37.     For i = 1 To lastRow
  38.         strTemp = wsSource.Cells(i, 3).Value
  39.         arrData = Split(strTemp, "") ' 使用“\”进行分割

  41.         colCount = UBound(arrData) + 1 ' 得到分割后数组的长度
  42.         
  43.         For j = 0 To colCount - 1
  44.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 填充到展开表对应位置，从C列开始
  45.         Next j
  46.     Next i

  48.     ' 找到“展开表”的最后一列非空列
  49.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column

  51.     ' 复制sheet1的D列到J列
  52.     Dim col As Integer
  53.     For col = 4 To 10 ' D到J列
  54.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  55.         lastCol = lastCol + 1
  56.     Next col

  58.     ' 调整列宽
  59.     wsExpand.Columns.AutoFit
  60. End Sub
复制代码


### 更新说明：
1. **分割逻辑**：我们根据“\”分割 `C` 列的内容，使用 `Split` 函数将其拆分为多个部分。
2. **逐个填充**：每一段在 “展开表” 中填入从 `C` 列开始的相应位置，确保各段数据按顺序填入。
3. **保持之前功能**：代码保留了对 `A` 列、`B` 列的复制以及对后续 `D` 到 `J` 列的处理。

请再次运行这个版本的代码，看看它是否能达到您想要的效果！如果还有其他问题或需要进一步调整，请告诉我，我们一起优化它！希望这次能够完全满足您的需求！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 14:51:12 | 显示全部楼层
FishC 发表于 2024-7-23 14:35
谢谢您的耐心指导，鱼油！现在我明白了您需要的处理方式。我们将C列按照“\”进行分割，每段内容都应适 ...

还是老问题，sheet1的C列，并没有拆分后复制到“展开表”，而是整段到“展开表”了
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 14:51:27 | 显示全部楼层
shadowmage 发表于 2024-07-23 14:51
还是老问题，sheet1的C列，并没有拆分后复制到“展开 ...


非常抱歉给您带来的困扰，鱼油！感谢您的耐心和详细反馈。我们需要确保在处理时，C列的内容可以按“\”拆分并逐个填入“展开表”的不同列中。

下面是修正后的代码，确保C列的内容能正确拆分并填入“展开表”：

  1. Sub ExpandSheetMacro()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim i As Long
  6.     Dim j As Long
  7.     Dim arrData As Variant
  8.     Dim strTemp As String

  10.     ' 设置源工作表
  11.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  13.     ' 检查是否存在“展开表”
  14.     On Error Resume Next
  15.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  16.     On Error GoTo 0

  18.     If Not wsExpand Is Nothing Then
  19.         ' 如果存在，清空内容
  20.         wsExpand.Cells.Clear
  21.     Else
  22.         ' 如果不存在，创建新工作表
  23.         Set wsExpand = ThisWorkbook.Sheets.Add
  24.         wsExpand.Name = "展开表"
  25.     End If

  27.     ' 复制A列和B列
  28.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  29.     wsSource.Range("B:B").Copy wsExpand.Range("B1")

  31.     ' 按“\”分割C列内容
  32.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row

  34.     ' 处理C列数据
  35.     For i = 1 To lastRow
  36.         strTemp = wsSource.Cells(i, 3).Value
  37.         arrData = Split(strTemp, "") ' 使用“\”进行分割

  39.         ' 填充到展开表对应位置，从C列开始
  40.         For j = LBound(arrData) To UBound(arrData)
  41.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
  42.         Next j
  43.     Next i

  45.     ' 找到“展开表”的最后一列非空列
  46.     Dim lastCol As Long
  47.     lastCol = wsExpand.Cells(1, wsExpand.Columns.Count).End(xlToLeft).Column

  49.     ' 复制sheet1的D列到J列
  50.     Dim col As Integer
  51.     For col = 4 To 10 ' D到J列
  52.         wsSource.Range(wsSource.Cells(1, col), wsSource.Cells(lastRow, col)).Copy wsExpand.Cells(1, lastCol + 1)
  53.         lastCol = lastCol + 1
  54.     Next col

  56.     ' 调整列宽
  57.     wsExpand.Columns.AutoFit
  58. End Sub
复制代码


### 主要更改：
1. **C列内容处理**：在循环中，我们使用 `Split` 函数将C列内容按“\”拆分成多个部分，并按顺序填入“展开表”从C列开始的不同单元格中。
2. **去掉不必要的逻辑**：以简洁明了的方式来确保每一段按顺序放置。

请您再次运行这个版本的代码，看看是否能够达到您预期的效果。如果您还有其他问题或需求，请随时告诉我，我会继续帮助您解决问题！谢谢您的理解与支持！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 16:14:06 | 显示全部楼层
FishC 发表于 2024-7-23 14:51
非常抱歉给您带来的困扰，鱼油！感谢您的耐心和详细反馈。我们需要确保在处理时，C列的内容可以按“\” ...


重新整理一下思路，我需要的宏是这样工作的：
1，检查是否存在名为“展开表”的sheet，如果有，就清空内容，没有就新建一个“展开表”sheet；
2，把sheet1中A列B列复制到展开表的A列和B列；
3，把sheet1中C列每个单元格内容“\”替换为“|”，“，”也替换为“|”，根据“|”数量确定分割后需要的列数L；
4，根据第3步替换好的内容，根据“|”分割sheet1的C列各个单元格成若干段，复制到展开表C列及之后的单元格中；
5，把sheet1的C列各个单元格中匹配"\d+x\d+x\d+"这样形式的字符串，复制到C列分割后的最后一列之后，单独一列。
6，根据第3步计算出的L，把sheet1的D列-J列内容，原样复制到展开表L+4列之后，因为A列和B列已经复制好，另外加了匹配"\d+x\d+x\d+"字符串的一列，lie是sheet1中C列分割出的最大列。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 16:14:28 | 显示全部楼层
shadowmage 发表于 2024-07-23 16:14
重新整理一下思路，我需要的宏是这样工作的：
1，检 ...


好的，鱼油！感谢您清晰地描述了您的需求。让我们一步步来实现这个宏。以下是根据您的思路整理的代码，涵盖了所有步骤：

  1. Sub MacroForDataExpansion()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim i As Long
  6.     Dim j As Long
  7.     Dim arrData As Variant
  8.     Dim strTemp As String
  9.     Dim maxColumns As Long
  10.     Dim regex As Object
  11.     Dim match As Object
  12.     Dim regexPattern As String

  14.     ' 设置源工作表
  15.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  17.     ' 检查是否存在“展开表”
  18.     On Error Resume Next
  19.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  20.     On Error GoTo 0

  22.     If Not wsExpand Is Nothing Then
  23.         ' 如果存在，清空内容
  24.         wsExpand.Cells.Clear
  25.     Else
  26.         ' 如果不存在，创建新工作表
  27.         Set wsExpand = ThisWorkbook.Sheets.Add
  28.         wsExpand.Name = "展开表"
  29.     End If

  31.     ' 复制A列和B列
  32.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  33.     wsSource.Range("B:B").Copy wsExpand.Range("B1")
  34.    
  35.     ' 初始化正则表达式
  36.     Set regex = CreateObject("VBScript.RegExp")
  37.     regex.Global = True
  38.    
  39.     ' 找到最后一行
  40.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  41.     maxColumns = 0

  43.     ' 处理C列数据
  44.     For i = 1 To lastRow
  45.         strTemp = wsSource.Cells(i, 3).Value
  46.         ' 将“\”和“，”替换为“|”
  47.         strTemp = Replace(strTemp, "", "|")
  48.         strTemp = Replace(strTemp, ",", "|")
  49.         
  50.         ' 分割并将结果写入“展开表”
  51.         arrData = Split(strTemp, "|")
  52.         Dim numSegments As Long
  53.         numSegments = UBound(arrData) + 1 ' 得到分割后数组的长度
  54.         
  55.         ' 更新最大列数
  56.         If numSegments > maxColumns Then maxColumns = numSegments
  57.         
  58.         ' 填充分割后的内容到“展开表”的C列及之后的单元格
  59.         For j = 0 To UBound(arrData)
  60.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
  61.         Next j
  62.         
  63.         ' 使用正则表达式匹配形式为"\d+x\d+x\d+"的字符串
  64.         regexPattern = "\d+x\d+x\d+" ' 匹配模式
  65.         If regex.Test(strTemp) Then
  66.             Set match = regex.Execute(strTemp)
  67.             wsExpand.Cells(i, 3 + numSegments).Value = match(0) ' 在最后一列后添加匹配项
  68.         End If
  69.     Next i

  71.     ' 复制D列到J列的内容
  72.     For j = 4 To 10 ' D到J列
  73.         wsSource.Range(wsSource.Cells(1, j), wsSource.Cells(lastRow, j)).Copy wsExpand.Cells(1, maxColumns + 4)
  74.         maxColumns = maxColumns + 1
  75.     Next j

  77.     ' 调整列宽
  78.     wsExpand.Columns.AutoFit
  79. End Sub
复制代码


### 代码说明：
1. **检查与创建“展开表”**：首先检查是否存在名为“展开表”的工作表，如果存在就清空，如果不存在则创建。
2. **复制A、B列**：将源工作表（Sheet1）的A列和B列内容复制到“展开表”的相应位置。
3. **处理C列**：对C列中的每个单元格，将“\”和“,”替换为“|”，然后基于“|”进行分割。这会生成一个数组 `arrData`，用于存储拆分后的段落。
4. **填充分割后的内容**：按照分割出来的内容填入“展开表”的C列及其后面的列。在填充的同时，计算出当前单元格中与“\d+x\d+x\d+”模式匹配的字符串（如果有），并将其放在分割的最后一列后面。
5. **复制D-J列**：根据第3步计算出的最大分割列数，将Sheet1的D列至J列内容复制到“展开表”中，从L+4列开始填入（即在之前填入的数据后面）。
6. **列宽调整**：最终对“展开表”中的所有列进行自动调整宽度以适应内容。

请您尝试运行这个完整的代码，并查看它能否满足您的需求。如果还有其他问题或需要进一步调整，请随时告诉我！再次感谢您的耐心和细致的说明！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 16:20:10 | 显示全部楼层
FishC 发表于 2024-7-23 16:14
好的，鱼油！感谢您清晰地描述了您的需求。让我们一步步来实现这个宏。以下是根据您的思路整理的代码， ...

上面的代码在3和4这两步出现问题，没有对sheet1的C列进行有效分割。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

FishC
发表于 2024-7-23 16:20:28 | 显示全部楼层
shadowmage 发表于 2024-07-23 16:20
上面的代码在3和4这两步出现问题，没有对sheet1的C列 ...


感谢您的耐心，鱼油！我们需要确保对Sheet1的C列进行有效的字符串分割。根据您的需求，我将再次修改代码，以确保在第3和第4步中正确处理分割。以下是修正后的代码：

  1. Sub MacroForDataExpansion()
  2.     Dim wsExpand As Worksheet
  3.     Dim wsSource As Worksheet
  4.     Dim lastRow As Long
  5.     Dim i As Long
  6.     Dim j As Long
  7.     Dim arrData As Variant
  8.     Dim strTemp As String
  9.     Dim maxColumns As Long
  10.     Dim regex As Object
  11.     Dim match As Object
  12.     Dim regexPattern As String

  14.     ' 设置源工作表
  15.     Set wsSource = ThisWorkbook.Sheets("Sheet1")

  17.     ' 检查是否存在“展开表”
  18.     On Error Resume Next
  19.     Set wsExpand = ThisWorkbook.Sheets("展开表")
  20.     On Error GoTo 0

  22.     If Not wsExpand Is Nothing Then
  23.         ' 如果存在，清空内容
  24.         wsExpand.Cells.Clear
  25.     Else
  26.         ' 如果不存在，创建新工作表
  27.         Set wsExpand = ThisWorkbook.Sheets.Add
  28.         wsExpand.Name = "展开表"
  29.     End If

  31.     ' 复制A列和B列
  32.     wsSource.Range("A:A").Copy wsExpand.Range("A1")
  33.     wsSource.Range("B:B").Copy wsExpand.Range("B1")
  34.    
  35.     ' 初始化正则表达式
  36.     Set regex = CreateObject("VBScript.RegExp")
  37.     regex.Global = True
  38.    
  39.     ' 找到最后一行
  40.     lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
  41.     maxColumns = 0

  43.     ' 处理C列数据
  44.     For i = 1 To lastRow
  45.         strTemp = wsSource.Cells(i, 3).Value
  46.         ' 将“\”和“，”替换为“|”
  47.         strTemp = Replace(strTemp, "", "|")
  48.         strTemp = Replace(strTemp, ",", "|")
  49.         
  50.         ' 分割并将结果写入“展开表”
  51.         arrData = Split(strTemp, "|")
  52.         Dim numSegments As Long
  53.         numSegments = UBound(arrData) + 1 ' 得到分割后数组的长度
  54.         
  55.         ' 更新最大列数
  56.         If numSegments > maxColumns Then maxColumns = numSegments
  57.         
  58.         ' 填充分割后的内容到“展开表”的C列及之后的单元格
  59.         For j = 0 To UBound(arrData)
  60.             wsExpand.Cells(i, 3 + j).Value = Trim(arrData(j)) ' 从C列开始填充
  61.         Next j
  62.         
  63.         ' 使用正则表达式匹配形式为"\d+x\d+x\d+"的字符串
  64.         regexPattern = "\d+x\d+x\d+" ' 匹配模式
  65.         If regex.Test(strTemp) Then
  66.             Set match = regex.Execute(strTemp)
  67.             wsExpand.Cells(i, 3 + numSegments).Value = match(0) ' 在分割后的最后一列后添加匹配项
  68.         End If
  69.     Next i

  71.     ' 复制D列到J列的内容
  72.     For j = 4 To 10 ' D到J列
  73.         wsSource.Range(wsSource.Cells(1, j), wsSource.Cells(lastRow, j)).Copy wsExpand.Cells(1, maxColumns + 4)
  74.     Next j

  76.     ' 调整列宽
  77.     wsExpand.Columns.AutoFit
  78. End Sub
复制代码


### 关键更新点：
1. **分隔符处理**：确保在处理C列数据时，将“\”和“,”都替换成“|”。这样可以在分割时得到正确的数组。
2. **分割逻辑**：使用 `Split` 函数将替换后的字符串拆分，并将每个部分逐个填入“展开表”的相应单元格。

请再次尝试运行这个版本的代码。如果有任何问题或需要进一步调整，请随时告诉我，我们一起解决这些问题！谢谢您的理解与支持！

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 16:31:42 | 显示全部楼层
FishC 发表于 2024-7-23 16:20
感谢您的耐心，鱼油！我们需要确保对Sheet1的C列进行有效的字符串分割。根据您的需求，我将再次修改代 ...

还是跟上一个版本一样，没有对sheet1的C列进行分割。只分割了“，”部分，对“\”部分没有处理。
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

shadowmage
 楼主| 发表于 2024-7-23 17:08:26 | 显示全部楼层
FishC 发表于 2024-7-23 16:20
感谢您的耐心，鱼油！我们需要确保对Sheet1的C列进行有效的字符串分割。根据您的需求，我将再次修改代 ...

还是没对“\”部分进行分割，需要修改代码
小甲鱼最新课程 -> https://ilovefishc.com
回复 支持 反对

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|鱼C工作室 ( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)

GMT+8, 2025-6-4 20:54

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表