1. 程式人生 > >VBA -- 實現按指定條件拆分工作表的功能

VBA -- 實現按指定條件拆分工作表的功能

大資料背景下,資料變成了巨大的財富。各種資料庫如關係型資料庫SQL/Oracle和非關係型資料庫MangoDB/Redis等的演化和應用更加豐富;同時資料分析從資料採集、資料預處理到資料整合、資料探勘的需求也更大。從資料採集到資料探勘,最終服務企業運營,是一條完整和嚴謹的資料分析流程。在完成高大上的資料探勘之前,資料採集、預處理到資料整合是不容忽視的基礎工作,也是十分繁瑣和費時的過程。

現在,許多企業中有大批工作人員工作內容與資料分析的前三個工作流程密切相關,常用軟體是Microsoft Excel。日常擺脫不了“表”的糾纏而加班,可能是許多上班族同仁的痛點吧。

個人因興趣而開此公眾號,藉此發一些資料分析理論基礎/軟體操作/程式設計等的方法或心得,希望能對人對已有所幫助。作為引子,先發一篇VBA按條件拆分工作表的方法,希望有所幫助。

作為例子,建立一個名為“ALL”的工作表,存放了13位不同年齡、不同部門的員工名單。欄位包括員工號/姓名/部門和年齡。


現要求按照部門,將十三位員工拆分至所屬部門的工作表中。實現功能的VBA程式碼如下:

(1)新建以部門名稱命名的工作表,程式碼如下:

Sub SplitByDept()

'定義k,b為整數

Dim k%,b%

Sheets(1).Activate

'停止頁面重新整理,減少記憶體佔用

Application.ScreenUpdating = False

'在列表最後一列後取全部部門名稱(工具列)

Range("E2:E14").Value = Range("C2:C14").Value

'工具列去除重複項

Range("E2:E14").RemoveDuplicates 1

'根據部門數量,新建工作表並以部門名稱命名

For k = 2 To 6
    a = Sheets(1).Range("E" & k).Value

    b = Sheets.Count

    Sheets.Add after:=Sheets(b)
    Sheets(b+1).Name = a

    '將ALL工作表表頭取至新工作表

    Sheets(b+1).Range("A1:D1").Value = _
     Range("A1:D1").Value

Next

'清除工具列資料

Range("E2:E14").ClearContents
Application.ScreenUpdating = True
End Sub


(2)將員工分配至所屬部門工作表,程式碼如下:

Sub MoveEmployeesToDept()
Application.ScreenUpdating = False
'全部員工資訊寫入陣列
arr = Range("A2:D14").Value
'獲取陣列最大索引
a = UBound(arr)
'迴圈檢查員工部門與工具列部門資訊
For i = 1 To a
    For j = 2 To 6
        If arr(i, 3) = Range("E" & j) Then
            With Sheets(j)
            x = .Range("A10").End(xlUp).Row
                '部門資訊一致的寫入對應工作表
                For k = 1 To 4
                    .Cells(x + 1, k) = arr(i, k)
                Next
            End With
        End If
    Next
Next
'清除工具列資料
Range("E2:E14").ClearContents
Application.ScreenUpdating = True
Erase arr

Thisworkbook.Save

End Sub

以上兩部門程式碼實現了將員工總表按照所屬部門進行拆分的功能。實現結果如下圖:


本文介紹了通過VBA拆分工作表的方法,也丟擲了個人公眾號的“VBA引子”。VBA語言比較簡單易懂,而且對實際工作有很大的幫助,後期文章將根據情況介紹VBA基礎及其他高階的應用。另外下一個“引子”打算丟擲python爬蟲,後期也將繼續更新python基礎、python各種庫的呼叫,以及tableau畫圖軟體的應用等。

歡迎大家關注本人微信公眾號,公眾號將持續更新python,tableau,SQL等資料分析的文章。

ID: DataDreamInitiate

      公眾號名稱資料分析X小碩