根据单元里姓名多少拆分行

fgq5910

需求：
根据单元里姓名多少拆分行
如：表1中F3里姓名有2个，就拆分为2行
       表1中F4里姓名有4个，就拆分为4行
       其他不变
谢谢！

lsc900707

有关拆分的实例论坛里有很多呀，自己搜索试试！

shiruiqiang

==============

cidanji

用VBA根据单元里姓名多少拆分行.zip (25.4 KB, 下载次数: 20)

2023-12-14 18:26 上传

点击文件名下载附件

fgq5910

shiruiqiang 发表于 2023-12-14 18:09
==============

非常感谢！
运行成功

fgq5910

cidanji 发表于 2023-12-14 18:27

非常感谢！
运行成功

x-xx-xx

1. Sub Macro1()
   
2.    
   
3.     S20230717_132705_拆分行_分隔符
   
4.    
   
5. End Sub
   
6. Sub S20230717_132705_拆分行_分隔符()
   
7.    
   
8.     Dim 编号01_单元格区域
   
9.     Dim 编号02_第几列
   
10.     Dim 编号03_数组
    
11.     Dim 编号04_工作簿
    
12.    
    
13.     '标记
    
14.     'Set 编号01_单元格区域 = Application.InputBox(prompt:="选择单元格区域", Title:="", Default:="单元格区域", Type:=8)
    
15.     'Set 编号01_单元格区域 = Selection
    
16.     Set 编号01_单元格区域 = Worksheets("表1").Range("A3:M23")
    
17.    
    
18.     编号03_数组 = 编号01_单元格区域.Value
    
19.    
    
20.    
    
21.    
    
22.     '标记
    
23.     '编号02_第几列 = Application.InputBox(prompt:="指定按第几列拆分", Title:="", Default:="数字", Type:=1)
    
24.     编号02_第几列 = 6
    
25.    
    
26.    
    
27.    
    
28.     '标记
    
29.     'S20220515_163613_xx 编号03_数组, 编号02_第几列, ","
    
30.     S20220515_163613_xx 编号03_数组, 编号02_第几列, "、"
    
31.    
    
32.    
    
33.    
    
34.    
    
35.     '标记
    
36.     'Set 编号04_工作簿 = Workbooks.Add
    
37.     '编号04_工作簿.Worksheets(1).Range("A1").Resize(UBound(编号03_数组, 1), UBound(编号03_数组, 2)) = 编号03_数组
    
38.    
    
39.     Worksheets("表2").Range("A3").Resize(UBound(编号03_数组, 1), UBound(编号03_数组, 2)) = 编号03_数组
    
40.    
    
41. End Sub
    
42. Sub S20220515_163613_xx(数组, 按第几列拆分, 分隔符)
    
43.    
    
44.     Dim 编号01_数组
    
45.     Dim 编号02_第几列
    
46.     Dim 编号03_行数
    
47.     Dim 编号04_第几行
    
48.     Dim 编号05_数字
    
49.     Dim 编号06_数组()
    
50.     Dim 编号07_列数
    
51.     Dim 编号08_第几行
    
52.     Dim 编号09_第几行
    
53.     Dim 编号10_第几列
    
54.     Dim 编号11_分隔符的个数
    
55.     Dim 编号12_字符串
    
56.     Dim 编号13_数组
    
57.    
    
58.     编号01_数组 = 数组
    
59.     编号02_第几列 = 按第几列拆分
    
60.    
    
61.     编号03_行数 = 0
    
62.     For 编号04_第几行 = 1 To UBound(编号01_数组, 1) Step 1
    
63.         
    
64.         编号12_字符串 = 编号01_数组(编号04_第几行, 编号02_第几列)
    
65.         
    
66.         编号11_分隔符的个数 = Len(编号12_字符串) - Len(Replace(编号12_字符串, 分隔符, ""))
    
67.         编号05_数字 = 编号11_分隔符的个数 + 1
    
68.         
    
69.         编号03_行数 = 编号03_行数 + 编号05_数字
    
70.         
    
71.     Next
    
72.    
    
73.     编号07_列数 = UBound(编号01_数组, 2)
    
74.    
    
75.     Erase 编号06_数组
    
76.     ReDim Preserve 编号06_数组(1 To 编号03_行数, 1 To 编号07_列数)
    
77.    
    
78.     编号08_第几行 = 0
    
79.    
    
80.     For 编号04_第几行 = 1 To UBound(编号01_数组, 1) Step 1
    
81.         
    
82.         编号12_字符串 = 编号01_数组(编号04_第几行, 编号02_第几列)
    
83.         
    
84.         编号11_分隔符的个数 = Len(编号12_字符串) - Len(Replace(编号12_字符串, 分隔符, ""))
    
85.         编号05_数字 = 编号11_分隔符的个数 + 1
    
86.         
    
87.         If 编号05_数字 > 1 Then
    
88.             
    
89.             For 编号09_第几行 = 1 To 编号05_数字 Step 1
    
90.                
    
91.                 编号08_第几行 = 编号08_第几行 + 1
    
92.                
    
93.                 编号13_数组 = Split(编号12_字符串, 分隔符)
    
94.                
    
95.                 For 编号10_第几列 = 1 To UBound(编号01_数组, 2) Step 1
    
96.                     
    
97.                     If 编号10_第几列 = 编号02_第几列 Then
    
98.                         
    
99.                         编号06_数组(编号08_第几行, 编号10_第几列) = 编号13_数组(编号09_第几行 - 1)
    
100.                         
     
101.                     Else
     
102.                         
     
103.                         编号06_数组(编号08_第几行, 编号10_第几列) = 编号01_数组(编号04_第几行, 编号10_第几列)
     
104.                         
     
105.                     End If
     
106.                     
     
107.                 Next
     
108.                
     
109.             Next
     
110.             
     
111.         End If
     
112.         
     
113.         If 编号05_数字 = 1 Then
     
114.             
     
115.             编号08_第几行 = 编号08_第几行 + 1
     
116.             
     
117.             For 编号10_第几列 = 1 To UBound(编号01_数组, 2) Step 1
     
118.                
     
119.                 编号06_数组(编号08_第几行, 编号10_第几列) = 编号01_数组(编号04_第几行, 编号10_第几列)
     
120.                
     
121.             Next
     
122.             
     
123.         End If
     
124.         
     
125.     Next
     
126.    
     
127.     数组 = 编号06_数组
     
128.    
     
129. End Sub
     

复制代码

那时雨

x-xx-xx 发表于 2023-12-14 21:01

这么长的代码？你是认真的。

那时雨

参与一下，练练手……

titi012

x-xx-xx 发表于 2023-12-14 21:01

你是怎么写出来的？太牛了啊！