求助大神，一个WPS表格，如何按某一列的内容拆分成多个表格，表格以单元格内容命名

yf865471

版主好勤劳，突然发现，你这个问题从2018年开始问的，今天又迭代功能了

lsc900707

yanhuai001 发表于 2021-12-10 14:40
你好，像标题行有2行或者更多行的拆分后只有第一行了，可以加一个选择标题行数的选择框然后再拆分吗？

标题多行，只要修改两个地方就可以啊。

yanhuai001

lsc900707 发表于 2021-12-13 07:22
标题多行，只要修改两个地方就可以啊。

刚接触VBA小白，可以具体说说怎么修改吗？

lsc900707

yanhuai001 发表于 2021-12-13 07:33
刚接触VBA小白，可以具体说说怎么修改吗？

1. Sub 保留表头拆分数据为若干新工作簿()
   
2.      Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
   
3.      c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
   
4.      If c = 0 Then Exit Sub
   
5.      Application.ScreenUpdating = False
   
6.      Application.DisplayAlerts = False
   
7.      arr = [a1].CurrentRegion
   
8.      lc = UBound(arr, 2)
   
9.      Set rng = [a1].Resize(2, lc)
   
10.      Set d = CreateObject("scripting.dictionary")
    
11.      For i = 3 To UBound(arr)
    
12.          If Not d.Exists(arr(i, c)) Then
    
13.              Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
    
14.          Else
    
15.              Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
    
16.          End If
    
17.      Next
    
18.      k = d.Keys
    
19.      t = d.Items
    
20.      For i = 0 To d.Count - 1
    
21.          With Workbooks.Add(xlWBATWorksheet)
    
22.              rng.Copy .Sheets(1).[a1]
    
23.              t(i).Copy .Sheets(1).[a3]
    
24.              .SaveAs Filename:=ThisWorkbook.Path & "" & k(i), FileFormat:=xlExcel8
    
25.              .Close
    
26.          End With
    
27.      Next
    
28.      Application.DisplayAlerts = True
    
29.      Application.ScreenUpdating = True
    
30.      MsgBox "完毕"
    
31. End Sub

复制代码

lsc900707

yanhuai001 发表于 2021-12-13 07:33
刚接触VBA小白，可以具体说说怎么修改吗？

自己看看修改的地方。

yanhuai001

lsc900707 发表于 2021-12-13 12:55
自己看看修改的地方。

感谢！！！

我的城市你来过

lsc900707 发表于 2018-7-24 10:20
参考附件：

老师，如果列中姓名有空白，如果把条件为空白的数据，提取到新的工作薄。