VBA實戰之新思路，一次循環解決按字段拆分問題

前面做了一次投票，發現很多同學對VBA高興趣，

所以我們今天來寫一篇VBA相關的實戰話題
按字段拆分，可能很多新手不能理解字段，通俗點講，可以理解為按標題，

比如姓名、商品名稱等等
網路上關於拆分的VBA代碼非常多

今天我們要分享的，目前網絡上應該還沒有，也算是今天偶然的一個思路吧

一般思路有：

1、高級篩選法-使用較少，數據量不大，還是一種不錯的思路

2、容錯複製粘貼法- 多次粘貼，導致效率低下

3、數組+循環 - 需要多次遍歷整個數據源

新思路是：字典+Union 一次粘貼。
Data:日常銷售表

執行效果：

代碼非常簡潔：

源碼分享：如何使用代碼：

<code>'功能：按字段拆分到工作表 

'日期：2020年4月5日
'作者：Excel辦公實戰-小易
Sub SplitDataToSht()
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    '獲取要拆分的數據源
    Dim arr
    arr = Sheet1.Range("a1").CurrentRegion.Value
    
    '字典+Union 一次循環分組
    Dim i As Long, curRang As Range, titleRng As Range
    For i = 2 To UBound(arr)
        '當前行數據
        Set curRang = Sheet1.Cells(i, 1).Resize(1, UBound(arr, 2))
        If Not d.exists(arr(i, 1)) Then
            Set titleRng = Sheet1.Cells(1, 1).Resize(1, UBound(arr, 2))
            '首次把標題行及對應數據加入
            Set d(arr(i, 1)) = Union(titleRng, curRang)
        Else
            '否則，把當前和前面滿足條件的拼接起來
            Set d(arr(i, 1)) = Union(d(arr(i, 1)), curRang)
        End If
    Next
    
    '創建工作表並寫入數據
    For i = 1 To d.Count
        Sheets.Add after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = d.keys()(i - 1)
            d.items()(i - 1).Copy .Range("a1")
        End With
    Next
    MsgBox "拆分完成！共" & d.Count & "個大類"
End Sub
/<code>

小結： 按字段拆分，也是工作表中比較常見的需求了，除了今天我們總結的新思路還有透視表也可以解決這個問題，不過如果操作頻繁，還是推薦VBA處理，基本形成模板，一鍵拆分

Excel辦公實戰，高效辦公，每天進步一點點！

閱讀更多 Excel辦公實戰 的文章

關鍵字: Excel 拆分 新思路