Excel VBA實(shí)例：將工作表拆分為多個(gè)工作簿

在實(shí)際工作中excel拆分成多個(gè)獨(dú)立表格，表格的批量拆分與批量合并是很常見(jiàn)的情況，注意是很多個(gè)表格，通過(guò)人力的方式來(lái)做費(fèi)時(shí)費(fèi)力，本文就來(lái)說(shuō)說(shuō)如何用VBA實(shí)現(xiàn)表格的批量拆分。

首先說(shuō)業(yè)務(wù)背景，某公司總部，需要每月跟各分公司確認(rèn)銷(xiāo)售人員的業(yè)績(jī)提成，這里有一份根據(jù)獎(jiǎng)勵(lì)政策匯總統(tǒng)計(jì)所有分公司的銷(xiāo)售業(yè)績(jī)提成表，表格如下。

以上表格，第一列是銷(xiāo)售人員編號(hào)，第二列是銷(xiāo)售人員所屬分公司，第三列是每個(gè)銷(xiāo)售人員的業(yè)績(jī)提成。

那我們需要做什么事呢？

我們需要將各個(gè)分公司的數(shù)據(jù)分開(kāi)，保存到一個(gè)新的表格里，最后另存為一個(gè)新的工作簿。

最終的效果如下圖所示。

如果手動(dòng)去拆分excel拆分成多個(gè)獨(dú)立表格，大致分為以下三步。

針對(duì)每個(gè)分公司，分別新建一個(gè)工作表。將每個(gè)分公司的數(shù)據(jù)篩選出來(lái)，保存到對(duì)應(yīng)的工作表里。將每個(gè)分公司的工作表另存為新的工作簿。

如果以上這些操作每月都要進(jìn)行，但是，對(duì)于匯總完的數(shù)據(jù)excel拆分成多個(gè)獨(dú)立表格，按照分公司分離到新表，再另存為新的工作簿完全是一個(gè)重復(fù)性的“體力活”，而且每月都會(huì)浪費(fèi)一定的時(shí)間。

如果通過(guò)VBA來(lái)解決，前期只要把代碼編寫(xiě)好，以后每月執(zhí)行一次就可以完成任務(wù)，可以節(jié)省大量的時(shí)間。

溫馨提示：閱讀以下內(nèi)容需要一定的VBA基礎(chǔ)哦。

接下來(lái)，說(shuō)說(shuō)如何用VBA代碼實(shí)現(xiàn)。

第一步：新建工作表

按照上表中的分公司名稱創(chuàng)建新工作表，VBA代碼如下。

Sub shtAdd()
    Dim sht As Worksheet, i As Integer   '新建一個(gè)worksheet對(duì)象
    i = 2
    Set sht = Worksheets("業(yè)績(jī)提成表")
    Do While sht.Cells(i, "B") <> ""
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = sht.Cells(i, "B").Value
    i = i + 1
    Loop
End Sub

上述代碼的意思就是通過(guò)一個(gè)循環(huán)對(duì)B列中的分公司名稱進(jìn)行循環(huán)，即對(duì)每一個(gè)分公司名稱建一個(gè)新工作表，并將分公司名稱作為新工作表的名稱。

可是，這樣做有一個(gè)問(wèn)題，B列中的分公司名稱有重復(fù)，一旦遇到之前創(chuàng)建過(guò)工作表的分公司名稱，再創(chuàng)建工作表就會(huì)出現(xiàn)如下圖所示的錯(cuò)誤。

因?yàn)楣ぷ鞅淼拿Q是不能重復(fù)的，所以，需要考慮重復(fù)的情況。

第二步：考慮重復(fù)的新建工作表

考慮到重復(fù)，將前面的VBA代碼修改一下。

Sub shtAdd()
    Dim sht As Worksheet, i As Integer
    i = 2
    Set sht = Worksheets("業(yè)績(jī)提成表")
    
    Do While sht.Cells(i, "B") <> ""
        On Error Resume Next
        If Worksheets(sht.Cells(i, "B").Value) Is Nothing Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = sht.Cells(i, "B").Value
        End If
    i = i + 1
    Loop
End Sub

上述代碼主要修改了兩個(gè)地方：

1、在循環(huán)中增加一個(gè)if條件判斷，表示當(dāng)某個(gè)分公司名稱的表格不存在時(shí)，就創(chuàng)建一個(gè)新的工作表。

2、增加了一行代碼On Next，表示當(dāng)發(fā)生錯(cuò)誤時(shí)，忽略錯(cuò)誤，繼續(xù)執(zhí)行下一行。

為啥要增加這行代碼？

但是當(dāng)(sht.(i, "B").)不存在時(shí)，會(huì)報(bào)錯(cuò)。

執(zhí)行上述VBA代碼，就完成了新建工作表，如下圖所示。

第三步：批量對(duì)數(shù)據(jù)分類

此時(shí)的新工作表還沒(méi)有數(shù)據(jù)，所以需要將每個(gè)分公司的數(shù)據(jù)篩選出來(lái)，然后分別復(fù)制到各個(gè)分公司的新工作表中。

VBA代碼如下。

Sub fenlei()
    Dim i As Integer, cName As String, rng1 As Range, rng2 As Range
    i = 2
    Worksheets("業(yè)績(jī)提成表").Select
    cName = Cells(i, "B").Value
    Do While cName <> ""
        Set rng1 = Worksheets(cName).Range("A1")
        Cells(1, "A").Resize(1, 3).Copy rng1
        
        Set rng2 = Worksheets(cName).Range("A1000").End(xlUp).Offset(1, 0)
        Cells(i, "A").Resize(1, 3).Copy rng2
        i = i + 1
        cName = Cells(i, "B").Value
    Loop
End Sub

上述代碼的意思就是通過(guò)一個(gè)循環(huán)去遍歷原來(lái)的工作表，將每一條記錄按照分公司名稱復(fù)制到之前新建的工作表中，只是每次循環(huán)的時(shí)候都將表頭，也就是第一行的字段名稱，也復(fù)制到每個(gè)工作表的第一行。

第四步：將工作表保存為新工作簿

此時(shí)，每個(gè)分公司對(duì)應(yīng)的工作表中已經(jīng)有了數(shù)據(jù)，如下圖所示。

接下來(lái)需要將每個(gè)工作表都保存為一個(gè)單獨(dú)的工作簿，VBA代碼如下。

Sub saveTowb()
    Application.ScreenUpdating = False
    Dim dir As String
    dir = ThisWorkbook.Path & "\各分公司業(yè)績(jī)表"
    Dim sht As Worksheet
    
    For Each sht In Worksheets
        sht.Copy
        ActiveWorkbook.SaveAs dir & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

以上VBA代碼的意思是將每個(gè)工作表保存到當(dāng)前路徑下的“各分公司業(yè)績(jī)表”文件夾中，并且命名為工作表的名稱，最終拆分出來(lái)的表格如下所示。

上圖中，可以看到拆分出來(lái)的表格也包括最開(kāi)始的業(yè)績(jī)提成表。

以上就是用VBA實(shí)現(xiàn)表格的批量拆分，當(dāng)然這是一個(gè)簡(jiǎn)化后的表格，實(shí)際業(yè)務(wù)的表格會(huì)比這個(gè)復(fù)雜很多，但是這個(gè)表格對(duì)于我們理解表格的批量拆分是沒(méi)有影響的，因?yàn)樵硎且粯拥摹?/p>

想要系統(tǒng)學(xué)習(xí)數(shù)據(jù)分析？請(qǐng)查看以下專欄。

免責(zé)聲明：本文系轉(zhuǎn)載，版權(quán)歸原作者所有；旨在傳遞信息，不代表本站的觀點(diǎn)和立場(chǎng)和對(duì)其真實(shí)性負(fù)責(zé)。如需轉(zhuǎn)載，請(qǐng)聯(lián)系原作者。如果來(lái)源標(biāo)注有誤或侵犯了您的合法權(quán)益或者其他問(wèn)題不想在本站發(fā)布，來(lái)信即刪。