|
歡迎轉(zhuǎn)發(fā)和點(diǎn)一下“在看”，文末留言互動(dòng)! 置頂公眾號(hào)或設(shè)為星標(biāo)及時(shí)接收更新不迷路
朋友們好，今天和大家分享一道文本合并、排序的題目。今天向大家介紹的是一段VBA代碼，非常簡潔高效地解決了問題。 原題目如下：  題目要求將左側(cè)的數(shù)據(jù)結(jié)構(gòu)轉(zhuǎn)換為右側(cè)的結(jié)構(gòu)，并有兩個(gè)潛在的要求：一是對(duì)相同客戶的數(shù)據(jù)進(jìn)行數(shù)據(jù)合并，二是對(duì)合并后的數(shù)據(jù)進(jìn)行排序。 使用公式是比較困難的，考慮使用VBA來處理。 01 VBA字典  完整代碼如下： Sub 合并() Dim i%, arr As Variant, mydic As Object, d Set mydic = CreateObject("scripting.dictionary") arr = Range("A1").CurrentRegion For i = 2 To UBound(arr) d = arr(i, 2) If mydic.exists(d) Then mydic(d) = Array(d, mydic(d)(1) + 1, mydic(d)(2) & ", " & arr(i, 4)) Else mydic(d) = Array(d, 1, arr(i, 4)) End If Next [F9].Resize(mydic.Count, 3) = Application.Transpose(Application.Transpose(mydic.items)) Range("F9:H14").Select Application.CutCopyMode = True Sheet1.Sort.SortFields.Clear Sheet1.Sort.SortFields.Add2 Key:=Range("G9:G14"), Order:=xlDescending Sheet1.Sort.SortFields.Add2 Key:=Range("F9:F14"), Order:=xlAscending With Sheet1.Sort .SetRange Range("F9:H14") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End WithEnd Sub這段代碼主要分為兩個(gè)部分。第一部分使用字典將數(shù)據(jù)合并，第二部分排序。 For i = 2 To UBound(arr) d = arr(i, 2) If mydic.exists(d) Then mydic(d) = Array(d, mydic(d)(1) + 1, mydic(d)(2) & ", " & arr(i, 4)) Else mydic(d) = Array(d, 1, arr(i, 4)) End IfNext 這部分，將源數(shù)據(jù)裝入字典。不過請(qǐng)注意，這里有一個(gè)特別的用法。 mydic(d) = Array(d, 1, arr(i, 4)) mydic(d) = Array(d, mydic(d)(1) + 1, mydic(d)(2) & ", " & arr(i, 4)) 當(dāng)鍵在字典中不存在時(shí)，對(duì)其賦值，所賦的值是一個(gè)數(shù)組，在這個(gè)數(shù)組中包含了“客戶名稱、常量1、合同編號(hào)”。 字典的鍵值是一個(gè)數(shù)組，在這個(gè)數(shù)組中，同時(shí)對(duì)客戶進(jìn)行累計(jì)計(jì)數(shù)，以及合同合并。 [F9].Resize(mydic.Count, 3) = Application.Transpose(Application.Transpose(mydic.items)) 數(shù)據(jù)裝入字典后結(jié)果輸出。這里使用了2次Application.Transpose。 Range("F9:H14").SelectApplication.CutCopyMode = TrueSheet1.Sort.SortFields.ClearSheet1.Sort.SortFields.Add2 Key:=Range("G9:G14"), Order:=xlDescendingSheet1.Sort.SortFields.Add2 Key:=Range("F9:F14"), Order:=xlAscendingWith Sheet1.Sort .SetRange Range("F9:H14") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .ApplyEnd With數(shù)據(jù)輸出后，就要對(duì)其進(jìn)行排序了。來錄入一段排序的VBA代碼。大功告成，打個(gè)響指！ -END- 我就知道你“在看”  |
|
|
