如何把一个excel表的数据按照条件筛选并分成多个表，使之成为工作簿

summerflyk

如上传文件所示，需要将test文件按照A列区域进行分类，并按照名称建立相对应的表格，并把相关的数据带到相对应的表格里，达到test效果。实际文件较大，A列共需要区分的表格大概有30个。求帮忙，谢谢

iwangyi

Sub 分表()
Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
Sql = "SELECT DISTINCT 区域 FROM [SHEET1$]"
Set RS = CN.Execute(Sql)
Do Until RS.EOF
QU = RS.FIELDS(0)
With Sheets.Add(AFTER:=Sheets(Sheets.Count))
.Name = QU
SqlL = "SELECT * FROM [SHEET1$] WHERE 区域='" & QU & "'"
Rows(1).Copy .Rows(1)
.Range("A2").CopyFromRecordset CN.Execute(SqlL)
End With
RS.MOVENEXT
Loop
End Sub

iwangyi

附件请参考

iwangyi

Sub 字典方法分表()
Set D = CreateObject("SCRIPTING.DICTIONARY")
ARR = Sheet1.UsedRange
For I = 2 To UBound(ARR)
D(ARR(I, 1)) = ""
Next
K = D.KEYS
Stop
For Each QU In K
N = 1
With Sheets.Add(AFTER:=Sheets(Sheets.Count))
.Name = QU
Rows(1).Copy .Rows(1)
For Each Rng In Range("A2:A" & UBound(ARR))
If QU = Rng Then
N = N + 1
Rng.Resize(, 19).Copy .Cells(N, 1)
End If
Next
End With
Next
End Sub

iwangyi

字典方法分表附件请参考

lsc900707

按列拆分的案例多如牛毛。

summerflyk

iwangyi 发表于 2018-8-28 17:44
Sub 分表()
Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.jet.OLEDB.4.0;E ...

非常感谢，但是运行的时候分表的第一行显示不出来，使用您的文件运行就能运行出来，小白一个，请见谅，争取早日脱离伸手党