國別 跨國
France 0
Japan; Japan 0
USA; USA; USA 0
Japan; South Korea 2
Singapore; Italy; USA; Italy 3
Japan; Japan; Japan; Japan 0
Japan; Japan; Japan 0
South Korea; South Korea; South Korea 0
Turkey; USA 2作者: oobird 時間: 2010-8-20 11:51
Option Explicit
Sub TEST()
Dim Brr, Y, x, A, N%, i&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([B2], [A65536].End(3))
'↑令Brr變數是 二維陣列,以儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈
A = Split(Replace(Brr(i, 2), " ", "") & ";", ";")
'↑令A變數是一維陣列,以";"字元分割字串帶入
For Each x In A
'↑設逐項迴圈!x變數是A一維陣列裡的陣列子
If x <> "" Then
'↑如果x變數不是空字元?
Y(x) = ""
'↑令x變數是key,item是空字元,納入Y字典裡(濾重複)
N = N + 1
'↑令N變數累加1 (累加國數)
End If
Next
Brr(i, 1) = N: N = 0
'↑令原陣列位置第1欄寫入N變數(國數),令N變數歸零(因為下個迴圈要用此變數)
Brr(i, 2) = IIf(Y.Count > 1, Y.Count, 0)
'↑令原陣列位置第2欄寫入 跨國數
Y.RemoveAll
'↑令清空Y字典
Next
[D1:E1] = [{"國別數","跨國數"}]
'↑令儲存格寫入標題列
[D2].Resize(UBound(Brr), 2) = Brr
'↑令Brr陣列值從[D2]開始帶入儲存格
Set Y = Nothing: Erase Brr, A
'↑令釋放變數
End Sub