楊老師課堂之Excel VBA 程序開發第六講根據部門列創建工作表

  課件下載 ：           

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

方式2：或點擊此處下載

效果預覽圖：

示例代碼：

Sub 根據部門創建表並且完成數據拆分最終版()


Dim sht As Worksheet '定義變量  sht作爲一個工作表對象
Dim i, k, j As Integer '定義變量 i,k,j 作爲一個整數類型對象
Dim m  As Integer '定義變量 m 作爲一個整數類型對象  表示 客戶端輸入的拆分列數
Dim irow  As Integer '定義變量 irow 作爲一個整數類型對象  代表的是有效數據的最後一行




irow = Sheet1.Range("a65536").End(xlUp).Row
'刪除
    Application.DisplayAlerts = False '不顯示刪除警告框
    For Each sht In Sheets          '表對象  sht 在  表集合(sheets)中進行循環
    
        If sht.Name <> "數據" Then   '如果表的名字  不等於  數據   那麼
        
            sht.Delete              ' 表執行刪除操作
            
        End If                      '結束如果語句
        
    Next                            ' 結束循環語句
    
    m = InputBox("請輸入你要按哪列進行拆分")  'input代表輸入 ， box爲盒子；  inputbox 表示：輸入框  m 代表接收 客戶端輸入的整數類型
    
    
'根據部門建表
For i = 2 To irow   ' i 代表整數  從2到有效數據的最後進行循環
    k = 0           ' k 代表一個標記   初始化時，就爲0，該標記作爲後面判斷的條件
    For Each sht In Sheets '表對象  sht 在  表集合(sheets)中進行循環
    
        If sht.Name = Sheet1.Cells(i, m) Then '如果表的名字 等於 第一個表的單元格(行，列) 那麼
            k = 1                       ' 將 標記變量  k  設置爲一個數字  例如：1
        End If       '結束如果語句
    Next      ' 結束循環語句
    
    If k = 0 Then '如果標記的變量 k  = 0   那麼  執行下列代表  但是如果不等於 則不執行
        Sheets.Add after:=Sheets(Sheets.Count)  '在最後一張表後執行添加表 操作
        Sheets(Sheets.Count).Name = Sheet1.Cells(i, m) ' 添加後的表的名字wie 第一個表的單元格(行，列)
    End If   '結束如果語句
Next        ' 結束循環語句

    '拷貝數據 ：j 代表的是表的序號
    For j = 2 To Sheets.Count
    ' 第一個表的單元格區域爲 a1 到 f 有效數據最後一行  執行篩選   篩選列爲 輸入的列m  條件是 表的名字(指定列名相同)
     Sheet1.Range("a1：f" & irow).AutoFilter Field:=m, Criteria1:=Sheets(j).Name
    ' 第一個表的單元格區域爲 a1 到 f 有效數據最後一行執行拷貝  到  循環到的某張表的a1單元格
     Sheet1.Range("a1：f" & irow).Copy Sheets(j).Range("a1")
    ' 第一個表的單元格區域爲 a1 到 f 有效數據最後一行 執行篩選(取消篩選操作)
     Sheet1.Range("a1：f" & irow).AutoFilter
    Next ' 結束循環語句
End Sub