標題: 分析可能重覆的欄值並在ListBox中Add唯一值,讓人員好選。 [打印本頁]

---

作者: apolloooo    時間: 2011-1-16 18:54     標題: 分析可能重覆的欄值並在ListBox中Add唯一值,讓人員好選。

A欄   
A
A
A
B
B
B
C
C
D
E
F
F
G


★Dept_Observing 是list Box
   變數A 只是判斷欄位值是否和listbox 相同的真假值。

要用VBA 應用 , 自己寫了一段程式，是為了在list box 只列出單一值(A,B,C,D,E,F,G)給人員方便點選。
但總覺得程式很長，可否幫忙簡化呢？
For I = 1 To 20   
      A = 0
        Text_Flag = Area.Cells(I, 1)
                 For J = 0 To Dept_Observing.ListCount - 1
                     If Dept_Observing.List(J) = Text_Flag  Then
                        A = 1
                        Exit For
                     End If
                Next J
        If A = 0 And Text_Flag <> "" Then
             Dept_Observing.AddItem Text_Flag
        End If
  Next I

---

作者: linshin1999    時間: 2011-1-16 20:14

本帖最後由 linshin1999 於 2011-1-16 20:15 編輯

回復 1# apolloooo

Dim Text_Flag as Range
Dim sd() as integer, sd_val as integer

For Each Text_Flag In Selection
       Sd_val = Asc(Text_Flag.Value)
       If sd(s_val) = 0 Then
             sd(s_val) = 1
             Dept_Observing.AddItem Text_Flag.Value
       End If
Next

---

作者: et5323    時間: 2011-1-16 21:46

Sub test()
    Dim arr, oDic As Object, i
    Set oDic = CreateObject("scripting.dictionary")
    With Sheet1
        arr = .Range("a1:a" & .[a65536].End(xlUp).Row)
    End With
    For i = 1 To UBound(arr)
        oDic(arr(i, 1)) = ""
    Next
    Dept_Observing.List = oDic.keys
    Set oDic = Nothing
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)