[發問] excel vba 如何重新排序下拉選單

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-8-5 13:49 | 只看該作者

求助我以下代碼增加入下拉選單item,
發覺下拉選單內的item不是順序的,我想排到順序,但是又不想影響工作表內的內容。
我應該怎樣寫?

Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
For Each A In .Range("A4:A600")
d(A.Value) = IIf(d(A.Value) = "", A.Offset(, 1).Value, d(A.Value) & "," & A.Offset(, 1))
Next
company1.List = d.keys
End With

複製代碼

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2016-8-8 06:08 | 只看該作者

回復 1# Patrick_Y
試試看

Option Explicit
Sub Ex()
Dim A As Range, I, D
Set D = CreateObject("Scripting.Dictionary")
With ActiveSheet
For Each A In .Range("A4:A600")
D(A.Value) = IIf(D(A.Value) = "", A.Offset(, 1).Value, D(A.Value) & "," & A.Offset(, 1))
Next
With .Cells(1, Columns.Count).Resize(D.Count) '工作表的最右邊一欄
.Cells = Application.WorksheetFunction.Transpose(D.keys) '導入資料
.Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo '排序,沒有標題列
company1.List = .Value
.Clear '清除
End With
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

論壇贊助勳章

3^#

發表於 2016-8-9 17:04 | 只看該作者

回復 2# GBKEE

感謝大大,
已成功排序

靜思自在 : 虛空有盡．我願無窮，發願容易行願難。