VBA实战四---根据自定义的某一列创建工作表

项目分析

项目所在地址
位置：王佩丰 VBA 课件\第七课

需求分析

在处理财务数据时，可能需要根据某一行中的数据对整个工作表进行分类创建各自的工作表

待处理的表格

解决思路及代码

1、对整个excel进行分析，判断是否存在一些无意义的工作表
（这里只是为了让最终生成的工作表只有我们需要的），若有，则删除

If Sheets.Count > 1 Then

    Excel.Application.DisplayAlerts = False
    
    'For g = 2 To Sheets.Count
    
        'Sheets(g).Delete
    'Next
    For Each sht In Sheets
        If sht.Name <> "数据" Then
            sht.Delete
        End If
    Next
    
    Excel.Application.DisplayAlerts = True
End If

2、根据我们选中的列去创建所有类别的工作表，此步需要遍历每一行的数据。

For i = 2 To row_number
    k = False
    
    For j = 1 To Sheets.Count
        If Sheet1.Cells(i, l).Value = Sheets(j).Name Then
            k = True
            Exit For
        End If
    Next
        
    If k = False Then
        '创建表格
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheet1.Cells(i, l).Value
        '复制第一行数据
        'Sheet1.Range("a1").EntireRow.Copy Sheets(Sheets.Count).Range("a1")
    End If
    
    
    'Sheet1.Range("a" & i).EntireRow.Copy Sheets(Sheet1.Range("d" & i).Value).Range("a" & Sheets(Sheet1.Range("d" & i).Value).Range("a65535").End(xlUp).Row + 1)

Next

3、采用筛选功能，将某一类别的数据筛选出来并复制到其所对应的工作表内。

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

最终效果图

1、先选择列数

2、运行结果

知识点总结

1、对于输入弹框只需要一下代码，注意其输入值可以赋值给变量，并且inputbox后需要添加括号

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

2、在删除无意义的工作表时，不能采用for循环而是用For each，
采用for循环时，会出现越界的问题，
这是因为当时你删除其中一个表格后，其后边表格数会减少即sheet2变成sheet1，最终删不干净。
3、删除工作表一定must要写：Excel.Application.DisplayAlerts = False
4、由于该项目中列数也变成的变量，
故在选择表格时，不能再使用Range,而是cells,原因如下：

选择工作表中表格的方法：

方法	解释
Range(“a1”).select	这里的行可以采用变量的形式，而列是采用字母表示不能采用变量
Cells(2，1).select	这里选中的是第一行第二列，行号和列号均可以采用变量表示

5、下面展示 弹框代码。

MsgBox "处理完毕"

整体代码

Sub shi()

Dim i, j, row_number, g As Integer
Dim k As Boolean
Dim l As Integer
Dim sht As Worksheet

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

row_number = Sheet1.Range("a65535").End(xlUp).Row

'删除无意义的表
If Sheets.Count > 1 Then

    Excel.Application.DisplayAlerts = False
    
    'For g = 2 To Sheets.Count
    
        'Sheets(g).Delete
    'Next
    For Each sht In Sheets
        If sht.Name <> "数据" Then
            sht.Delete
        End If
    Next
    
    Excel.Application.DisplayAlerts = True
End If


For i = 2 To row_number
    k = False
    
    For j = 1 To Sheets.Count
        If Sheet1.Cells(i, l).Value = Sheets(j).Name Then
            k = True
            Exit For
        End If
    Next
        
    If k = False Then
        '创建表格
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheet1.Cells(i, l).Value
        '复制第一行数据
        'Sheet1.Range("a1").EntireRow.Copy Sheets(Sheets.Count).Range("a1")
    End If
    
    
    'Sheet1.Range("a" & i).EntireRow.Copy Sheets(Sheet1.Range("d" & i).Value).Range("a" & Sheets(Sheet1.Range("d" & i).Value).Range("a65535").End(xlUp).Row + 1)

Next

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

MsgBox "处理完毕"

Sheet1.Select

End Sub