歡迎轉(zhuǎn)發(fā)和點一下“在看”,，文末留言互動!

置頂公眾號或設(shè)為星標及時接收更新不迷路

小伙伴們好，今天和大家分享一道VBA的題目,。原題是這樣的：

題目要求用公式完成,。但在2016版本下，這道題目用公式解答起來會比較困難,，因此我們改弦易張,，用VBA代碼來完成這道題目。

觀察一下源數(shù)據(jù),，主要由“戶主”和“家庭成員”這兩種類型構(gòu)成,，并且間隔排列。

可以這樣構(gòu)思：以“戶主”為判斷關(guān)鍵詞進行循環(huán),。只要源數(shù)據(jù)為“戶主”,，就對變量累計加1，同時將姓名裝入數(shù)組,；若源數(shù)據(jù)不是“戶主”,，則對姓名合并后裝入數(shù)組。全部完成后輸出即可,。

完整代碼如下：

Sub 表格轉(zhuǎn)換()    Dim arr As Variant, brr As Variant, i As Integer, k As Integer, s As String    arr = Range("A1").CurrentRegion    ReDim brr(1 To 6, 1 To 2)    For i = 2 To UBound(arr)        If arr(i, 2) = "戶主" Then k = k + 1: s = "": brr(k, 1) = arr(i, 3)        If arr(i, 2) <> "戶主" Then            s = s & ",，" & arr(i, 3)        End If        brr(k, 2) = Mid(s, 2)    Next    [G10].Resize(k, 2) = brrEnd Sub

If arr(i, 2) = "戶主" Then k = k + 1: s = "": brr(k, 1) = arr(i, 3)

當(dāng)源數(shù)據(jù)等于“戶主”時，令變量k累計加1,，同時令變量s為空值,，并將對應(yīng)的姓名裝入動態(tài)數(shù)組,。

If arr(i, 2) <> "戶主" Then    s = s & "，" & arr(i, 3)End If

若數(shù)據(jù)不等于“戶主”,，則對姓名進行合并,，并賦值給變量s。

brr(k, 2) = Mid(s, 2)

將姓名賦值給動態(tài)數(shù)組,。由于字符串s是以“,，”開頭的，因此要利用MID函數(shù)從第二位提取所有的剩余字符串,。

For i = 2 To UBound(arr)    If arr(i, 2) = "戶主" Then k = k + 1: s = "": brr(k, 1) = arr(i, 3)    If arr(i, 2) <> "戶主" Then        s = s & ",，" & arr(i, 3)    End If    brr(k, 2) = Mid(s, 2)Next

循環(huán)，直至完成姓名的合并,。以第8-11行數(shù)據(jù)為例,。

當(dāng)i=8，k累加至4,，brr(k, 1)=“孫云”

當(dāng)i=9,，k仍為4，s=“,，錢桂蘭”,，brr(k, 2) = “錢桂蘭”

當(dāng)i=10，k仍為4,，s=“,，錢桂蘭，王紅兵”,，brr(k, 2) = “錢桂蘭,，王紅兵”

當(dāng)i=11，k仍為4,，s=“,，錢桂蘭，王紅兵,，葛家泉”,，brr(k, 2) = “錢桂蘭，王紅兵,，葛家泉”

[G10].Resize(k, 2) = brr

最后輸出結(jié)果,。

本期內(nèi)容練習(xí)文件提取方式：

鏈接: https://pan.baidu.com/s/1ZQTFilcN6URsti9r5YK--g?pwd=fa53 提取碼: fa53