VBA之根据筛选条件创建新的工作表完整版

工作中,筛选条件肯定不止一个,有时候要筛选第一列,第二列,而不是某一个固定的列的条件

以上的ABCDEF列都有可能被当成筛选对象
代码如下

Sub chaifenshuju()

Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer

l = InputBox(“请输入你要按哪列分”)

'删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> “数据” Then
sht1.Delete
End If
Next
End If
Application.DisplayAlerts = True '这个地方上课的时候我没改成true，请大家注意一下

irow = Sheet1.Range(“a65536”).End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, l) Then
k = 1
End If
Next

If k = 0 Then
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If

Next
'拷贝数据

For j = 2 To Sheets.Count
Sheet1.Range(“a1:f” & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
Sheet1.Range(“a1:f” & irow).Copy Sheets(j).Range(“a1”)
Next

Sheet1.Range(“a1:f” & irow).AutoFilter

Sheet1.Select

MsgBox “已处理完毕”

End Sub

代码解读:
1.定义总行数
Dim irow As Integer '这个说的是一共多少行
irow = Sheet1.Range(“a65536”).End(xlUp).Row

2.根据用户的选择来进行筛选,这里要用到交互式弹窗,把用户输入的数字作为筛选的列
l = InputBox(“请输入你要按哪列分”)
3.删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> “数据” Then
sht1.Delete
End If
Next
End If
Application.DisplayAlerts = True
首先要关闭删除提示,然后判断表的数量是不是大于1,如果大于的话,就删除其他的表,这里没有用到for 2到多少,而是用了for each,防止删除表后的索引问题

4.拆分表
irow = Sheet1.Range(“a65536”).End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, l) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
这里用 Cells(i, l)代替了range(“l” & i)
因为range里的第一个参数是字母,不是变量,用cell代替,
cell的第一个参数是行数,第二个参数是列数
所以Cells(i, l)代表第i行第l列的数据

5.拷贝数据
For j = 2 To Sheets.Count
Sheet1.Range(“a1:f” & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
Sheet1.Range(“a1:f” & irow).Copy Sheets(j).Range(“a1”)
Next

Sheet1.Range(“a1:f” & irow).AutoFilter

Sheet1.Select

MsgBox “已处理完毕”