excel如何自动将表格按照某一列拆分出几个excel表,不要筛选功能的回答。比如有什么脚本之类的。
3个回答
展开全部
你是要拆分成工作簿啊,还是拆分到同一个工作簿的不同表?
下面这段代码,将按照代码所在表D列数据进行拆分,D列相同的放到一个工作簿中,工作簿名称为该单元格值。
Sub 拆分() 'D列相同的保存到一个工作簿
Dim I As Long, J As Long, S As String
Dim Str As String, xlbook As Workbook
Dim N As Long, R As Long, M As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For I = 1 To Range("D65536").End(xlUp).Row
Str = Range("D" & I).Text
If InStr(S, Str) = 0 And Str <> "" Then
S = S & Str & " "
N = N + 1
Workbooks.Add xlWBATWorksheet
Rows(I).Copy ActiveSheet.Rows(N)
R = Range("D:D").Find(Range("D" & I)).Row
M = R
Do
R = Range("D:D").FindNext(Range("D" & R)).Row
If R = M Then Exit Do
N = N + 1
Rows(R).Copy ActiveSheet.Rows(N)
Loop
ActiveWorkbook.SaveAs "D:\" & Str & ".XLS" '保存
ActiveWorkbook.Close
N = 0
Str = ""
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "完成!"
End Sub
下面这段代码,将按照代码所在表D列数据进行拆分,D列相同的放到一个工作簿中,工作簿名称为该单元格值。
Sub 拆分() 'D列相同的保存到一个工作簿
Dim I As Long, J As Long, S As String
Dim Str As String, xlbook As Workbook
Dim N As Long, R As Long, M As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For I = 1 To Range("D65536").End(xlUp).Row
Str = Range("D" & I).Text
If InStr(S, Str) = 0 And Str <> "" Then
S = S & Str & " "
N = N + 1
Workbooks.Add xlWBATWorksheet
Rows(I).Copy ActiveSheet.Rows(N)
R = Range("D:D").Find(Range("D" & I)).Row
M = R
Do
R = Range("D:D").FindNext(Range("D" & R)).Row
If R = M Then Exit Do
N = N + 1
Rows(R).Copy ActiveSheet.Rows(N)
Loop
ActiveWorkbook.SaveAs "D:\" & Str & ".XLS" '保存
ActiveWorkbook.Close
N = 0
Str = ""
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "完成!"
End Sub
追问
拆分成工作簿。请问您这个什么意思看不太懂,在哪里运行?
追答
九八七一二二八一七。你没有基础,这里说不清楚。扣扣
展开全部
举例或上图
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
你好:可以用公式引用。如这一列有明显的标志,可以用函数区分这些标志,就可以在不同的页显示数据。相当于自动分出不同的页。.
更多WPS办公软件教程,请访问:http://bbs.wps.cn或者http://e.weibo.com/wpswfw
更多WPS办公软件教程,请访问:http://bbs.wps.cn或者http://e.weibo.com/wpswfw
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询