chrisovo的部落格

問題：http://club.excelhome.net/thread-1395572-1-3.html

重點解法：

split(陣列 , 分割字符) => 分割後會變成一維陣列

程式碼：

Sub test()

Dim d, d2

Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")

arr = [A1].CurrentRegion

For i = 1 To [a65535].End(3).Row

'用字典抓出各類別所在的列數

    d(arr(i, 1)) = i

Next

'用Do的迴圈來要求使用者輸入要搜尋的類別

'原先是用if not A is nothing then...但A我並不是設定為物件而是變數，因此不能設為Nothing，要用""無資料。

'如果沒有資料的話 將inputbox回饋的類別設給變數B

'如果有資料的話則B = B & "、" & A

'最後迴圈直到msgbox回饋的訊息為vbno。

Do

    If Not A = "" Then
    
        A = InputBox("請輸入類別（僅限一個）")
    
        b = b & "、" & A
    
        Ans = MsgBox("是否還有？", vbYesNo)
    
    Else
    
        A = InputBox("請輸入類別（僅限一個）")
        
        b = A
        
        Ans = MsgBox("是否還有？", vbYesNo)
        
    End If
    
Loop Until Ans = vbNo

'將B變數用"、"字符分割，得到一維數列C

c = Split(b, "、")

'用迴圈先用Range("ZZ" & d(CInt(c(i)))).End(xlToLeft).Column 該類別的欄數

'd(c(i))的數值因"、"連接的關係變為文本，但寫入字典的關鍵字為數值，故在這邊有用Clnt將文本轉換為數值，避免出現錯誤

'抓出欄數後再用d2(arr(d(clnt(c(i))) , j )) = "" 來將各類別的細項抓入，同時去除重複。

For i = 0 To UBound(c, 1)

    E = Range("ZZ" & d(CInt(c(i)))).End(xlToLeft).Column

        For j = 2 To E
            
            d2(arr(d(CInt(c(i))), j)) = ""
            
        Next j

Next i

'H = d2.keys為一維陣列，若想要直接貼在儲存格不轉置的話需offset欄。

'另外一維陣列的上界為0，因此要用ubound抓下界時需+1，配合offset

H = d2.keys

[K1].Resize(UBound(H, 1) + 1, 1) = Application.Transpose(H)

End Sub