怎么分开

xiaomaoning

usedrange 发表于 2025-8-1 11:43

好的，感谢大神

半百

xiaomaoning 发表于 2025-8-2 09:19
ai，你是怎么描述生成的

起初我问deepseek：A到D，4列数据，其中B列单元格中为若干名称，以逗号隔开，请给出VBA代码，要求将B列单元格的内容以逗号拆分，每个名称一行，其它3列为原来的值。它给一段代码是直接覆盖原数据的，后来我又补充一下：上述代码拆分后储存到数组里，最后写入新的工作表。
然后它给出了以下代码

半百

xiaomaoning 发表于 2025-8-2 09:19
ai，你是怎么描述生成的

1. Sub SplitByCommaToNewSheet()
   
2.     Dim wsSource As Worksheet, wsDest As Worksheet
   
3.     Dim lastRow As Long, i As Long, j As Long, k As Long
   
4.     Dim splitValues As Variant
   
5.     Dim dataArr() As Variant
   
6.     Dim resultArr() As Variant
   
7.     Dim itemCount As Long, totalItems As Long
   
8.     Dim outputRow As Long
   
9.    
   
10.     ' 设置源工作表（这里使用活动工作表）
    
11.     Set wsSource = ActiveSheet
    
12.    
    
13.     ' 创建新工作表用于输出结果
    
14.     Set wsDest = Worksheets.Add(After:=wsSource)
    
15.     wsDest.Name = "拆分结果_" & Format(Now, "yyyymmdd_hhmmss")
    
16.    
    
17.     ' 获取源数据最后一行
    
18.     lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
19.    
    
20.     ' 将源数据读入数组（A到D列）
    
21.     dataArr = wsSource.Range("A1:D" & lastRow).Value
    
22.    
    
23.     ' 先计算总项目数，以确定结果数组大小
    
24.     totalItems = 0
    
25.     For i = 1 To UBound(dataArr, 1)
    
26.         If Not IsEmpty(dataArr(i, 2)) Then
    
27.             splitValues = Split(dataArr(i, 2), "，")
    
28.             totalItems = totalItems + (UBound(splitValues) + 1)
    
29.         Else
    
30.             totalItems = totalItems + 1
    
31.         End If
    
32.     Next i
    
33.    
    
34.     ' 重新定义结果数组（行数=总项目数，列数=4）
    
35.     ReDim resultArr(1 To totalItems, 1 To 4)
    
36.    
    
37.     ' 填充结果数组
    
38.     outputRow = 1
    
39.     For i = 1 To UBound(dataArr, 1)
    
40.         If Not IsEmpty(dataArr(i, 2)) Then
    
41.             splitValues = Split(dataArr(i, 2), "，")
    
42.             For j = LBound(splitValues) To UBound(splitValues)
    
43.                 ' A列（原始值）
    
44.                 resultArr(outputRow, 1) = dataArr(i, 1)
    
45.                 ' B列（拆分后的值，去除前后空格）
    
46.                 resultArr(outputRow, 2) = Trim(splitValues(j))
    
47.                 ' C列（原始值）
    
48.                 resultArr(outputRow, 3) = dataArr(i, 3)
    
49.                 ' D列（原始值）
    
50.                 resultArr(outputRow, 4) = 1 'dataArr(i, 4) 这个1是我改的
    
51.                 outputRow = outputRow + 1
    
52.             Next j
    
53.         Else
    
54.             ' 如果B列为空，直接复制整行
    
55.             resultArr(outputRow, 1) = dataArr(i, 1)
    
56.             resultArr(outputRow, 2) = ""
    
57.             resultArr(outputRow, 3) = dataArr(i, 3)
    
58.             resultArr(outputRow, 4) = dataArr(i, 1)
    
59.             outputRow = outputRow + 1
    
60.         End If
    
61.     Next i
    
62.    
    
63.     ' 将结果数组写入新工作表
    
64.     With wsDest
    
65.         ' 写入标题（如果需要）
    
66.         .Range("A1:D1").Value = Array("A列", "B列(拆分后)", "C列", "D列")
    
67.         '设置单元格格式为文本
    
68.         .Range("a:c").NumberFormatLocal = "@"  '这一句是我后加的
    
69.         ' 写入数据
    
70.         .Range("A2").Resize(UBound(resultArr, 1), UBound(resultArr, 2)).Value = resultArr
    
71.         ' 自动调整列宽
    
72.         .Columns("A:D").AutoFit
    
73.     End With
    
74.    
    
75.     MsgBox "处理完成！共拆分 " & totalItems & " 行数据。", vbInformation
    
76. End Sub
    

复制代码

lhm667788

let
    源 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
    按分隔符拆分列 = Table.ExpandListColumn(Table.TransformColumns(源, {{"宝贝标题 ", Splitter.SplitTextByDelimiter("，", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "宝贝标题 ")
in
    按分隔符拆分列

xiaomaoning

半百 发表于 2025-8-2 10:24
起初我问deepseek：A到D，4列数据，其中B列单元格中为若干名称，以逗号隔开，请给出VBA代码，要求将B列单 ...

哦哦，好的，感谢大神

xiaomaoning

lhm667788 发表于 2025-8-4 08:43
let
    源 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
    按分隔符拆分列 = Table.ExpandList ...

好的，感谢大神