【原】Excel VBA 數(shù)據(jù)源明細數(shù)據(jù)按指定格式排版

冷茶視界 2023-11-15 發(fā)布于江蘇

展開全文

快速瀏覽

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】

實用案例

|收費管理系統(tǒng)|中醫(yī)診所收費系統(tǒng)|

|日期控件|簡單的收發(fā)存|

|電子發(fā)票管理助手|Excel表格拆分神器|

|Excel多種類型文件合并 |

|電子發(fā)票登記系統(tǒng)（Access版）|

|批量生成憑證抽查底稿|

收費使用項目

|財務管理系統(tǒng)|

內(nèi)容提要

字典的用法
明細數(shù)據(jù)按指定格式排版

大家好,，我是冷水泡茶,，今天在網(wǎng)上論壇看到一個求助貼，他的問題是：能否把明細數(shù)據(jù)源按指定格式排版,？

他的數(shù)據(jù)表是這樣的,，左邊6列是明細數(shù)據(jù)，右邊幾列是分省的數(shù)據(jù)列表：

他的具體要求是：

1,、左邊表一(A至F列數(shù)據(jù)源),，數(shù)據(jù)有時多有時少，即是動態(tài)的?，F(xiàn)在把它轉(zhuǎn)換成表二 (J至Z列)那樣格式排車,。

2、右邊表二黃色的省份是根據(jù)表一的數(shù)據(jù)源的省份,，有時多有時少,，即是動態(tài)的。

3,、每個省份下,，先客戶排，客戶下再跟著它采購的商品和數(shù)量,，接著下一個客戶,，商品和數(shù)量一直下去。

4,、客戶靠左對齊,，且加粗,。

這跟我們昨天分享的案例【Excel VBA 學?？紙鲎话才?隨機調(diào)整】有點類似,，都是把明細數(shù)據(jù)轉(zhuǎn)換格式，但今天這個要稍微復雜一些,，經(jīng)過一番燒腦的操作,，終于達成目標,，我們一起來看一下：

基本思路

1,、把數(shù)據(jù)讀入數(shù)據(jù)，定義兩個字典,，一個存省份,，一個存客戶。

2,、循環(huán)省份,、客戶、明細數(shù)據(jù),，取得相應的商品名稱,、數(shù)量，對應寫入相應的數(shù)據(jù)區(qū)域,。

程序代碼

1,、模塊1，Arrange過程,，排版：

Sub Arrange()    Dim ws As Worksheet    Dim lastRow As Integer    Dim lastCoa As Integer    Dim arr(), arrTem(), arrProvince()    Dim dic As Object, dicProvince As Object    Set ws = ThisWorkbook.Sheets("數(shù)據(jù)源")    Set dic = CreateObject("Scripting.Dictionary")    Set dicProvince = CreateObject("Scripting.Dictionary")    With ws        lastRow = .UsedRange.Rows.Count        lastcol = .UsedRange.Columns.Count        arr = .Range("A1:F" & lastRow).Value        For i = 2 To UBound(arr)            If arr(i, 3) <> "" Then                dic(arr(i, 3) & "|" & arr(i, 4)) = arr(i, 4)                dicProvince(arr(i, 3)) = 1            End If        Next        arrTem = dic.keys        arrProvince = dicProvince.keys        With .Range(Cells(1, 10), Cells(lastRow, lastcol))            .Clear            .Font.Size = 10            .HorizontalAlignment = xlCenter        End With        For i = 0 To UBound(arrProvince)            k = 0            m = 0            .Cells(1, 10 + i * 3) = arrProvince(i)            .Cells(1, 10 + i * 3).Interior.Color = RGB(255, 255, 0)            For j = 0 To UBound(arrTem)                If InStr(arrTem(j), arrProvince(i)) Then                    Cells(2 + k + m, 10 + i * 3) = dic(arrTem(j))                    Cells(2 + k + m, 10 + i * 3).Font.Bold = True                    Cells(2 + k + m, 10 + i * 3).HorizontalAlignment = xlLeft                    m = m + 1                    For h = 2 To UBound(arr)                        If arr(h, 3) & "|" & arr(h, 4) = arrTem(j) Then                            Cells(2 + k + m, 10 + i * 3) = arr(h, 5)                            Cells(2 + k + m, 10 + i * 3 + 1) = arr(h, 6)                            k = k + 1                        End If                    Next                End If            Next        Next    End WithEnd Sub

代碼解析：

（1）定義一些變量,，工作表對象ws，數(shù)組,，字典等,。

（2）line11~19，把“數(shù)據(jù)源”表明細數(shù)據(jù)裝入數(shù)組,；循環(huán)數(shù)組,，把省份裝入字典dicProvince，把省份+客戶裝入字典dic,，item為客戶,。

（3）line20~11，把字典的key存入數(shù)組,，以便進行循環(huán),。

（4）line22~26，把排版區(qū)域清空,，設置字體=10,，單元格水平居中,。

（5）line27~47，循環(huán)省份,、客戶數(shù)組,，再循環(huán)arr明細數(shù)據(jù)，把對應省份,、客戶的商品名稱,、數(shù)量寫入右邊的排版區(qū)域，這里有兩個計數(shù)器,，省份變動一次,，m加1，客戶變動一次,，k加1,，并把它們增加到單元格行變量。在寫入省份,、客戶的時候,，把對應單元格的格式也一并設置。

2,、其他過程,，CmdClear命令按鍵，清空排版數(shù)據(jù)：

Private Sub CmdClear_Click()    With Sheets("數(shù)據(jù)源")        .Range("J1").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents    End WithEnd Sub