楊老師課堂之Excel VBA 程序開發第六講 根據制定列創建相應工作表及數據

版權聲明：本文爲博主原創文章，未經博主允許不得轉載。 https://blog.csdn.net/kese7952/article/details/80282484

  課件下載 ：           

方式1：本節課件下載地址 鏈接: https://pan.baidu.com/s/1pzBvCMOcG0Mnzr0IFj7LlQ 密碼: u9pk

方式2：或點擊此處下載

效果圖

代碼示例：

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