請教關於截取儲存格中的唯一值 - Excelㄧ般區

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

1^# 跳轉到 »

發表於 2010-10-8 09:19 | 顯示全部帖子

稍改一下妳的函數即可。

991008.rar (9.59 KB)

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

2^#

發表於 2010-10-8 10:00 | 顯示全部帖子

991008-1

991008-1.rar (11.44 KB)

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

3^#

發表於 2010-10-8 14:43 | 顯示全部帖子

Private Sub CommandButton1_Click()
Dim d As Object, arr, i%, j%, s$, s1$, sp
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range([a2], [b2].End(4))
For i = 1 To UBound(arr)
      s = arr(i, 2): s1 = arr(i, 1)
      If InStr(s, "、") = 0 And Not d.exists(s) Then d.Add s, s1
      sp = Split(s, "、")
      For j = 0 To UBound(sp)
         If Not d.exists(sp(j)) Then
            d.Add sp(j), s1
         Else
            d(sp(j)) = IIf(InStr(d(sp(j)), s1) = 0, d(sp(j)) & "、" & s1, d(sp(j)))
         End If
      Next j
Next i
[d2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[e2].Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing
End Sub

TOP

oobird