[發問] Dictionary之下,兩個Excel欄位聯合 作為判別條件

yangjie

請教大大 :
         Set d = CreateObject("Scripting.Dictionary")
                   With Sheets("基本資料")
                       For Each a In .Range(.Cells(2,3), .Cells(65536, 4).End(xlUp))
                           d(a & "") = ""
                       Next
                  End With
        If d.Count = 0 Then Exit Sub
     ListBox1.list = d.keys
結果 list 為兩個Excel欄位各自相異item  寫在同一list Column中
請教大大  應如何寫法   可將 兩個Excel欄位聯合  作為判別條件
  如   ListBox1.list = d.keys
得到   
            數學       9月2日
            數學       9月3日
            英文       9月2日
謝謝指導

yangjie

回復 4# yangjie
自己修正成  
Private Sub ComboBox1_DropButtonClick()
    If ComboBox1.Text = "" Then Exit Sub
    ListBox1.AddItem ComboBox1.List(ComboBox1.ListIndex, 0)
    ListBox1.List(ListBox1.ListCount - 1, 1) = ComboBox1.List(ComboBox1.ListIndex, 1)
    ComboBox1.RemoveItem (ComboBox1.ListIndex)
    ComboBox1.ListIndex = -1
End Sub
可有更簡單之語法?

yangjie

回復 2# GBKEE
謝 GBKEE 大大
經測試
                   For Each R In .Range(.Cells(2, 3), .Cells(65536, 4).End(xlUp)).Rows
                          D(A) = ""
------
                   .List = Application.Transpose(Application.Transpose(D.keys))
效果 出現重複
使用  3# 大大  可得  不重複之結果
但此兩欄 經click 到另一個listbox2中    .additem    listbox.text
卻僅得一欄    如何可得到兩欄

yangjie

回復 3# chin15
請教  chin15  大大
     謝謝指導
   原先用ComboBox1建立了  list  接者輸出  應如何輸入到listbox1中2個column內
Private Sub ComboBox1_DropButtonClick()
    If ComboBox1.Text = "" Then Exit Sub
    ListBox1.AddItem ComboBox1.Text    ------只出現一項  如何才可出現兩項
     ComboBox1.RemoveItem (ComboBox1.ListIndex)
    ComboBox1.ListIndex = -1
End Sub

chin15

1. Sub Ex()
   
2.     Dim D As Object, R As Range
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     With Sheet1
   
5.         For Each R In .Range(.Cells(2, 3), .Cells(65536, 4).End(xlUp)).Rows
   
6.             D(R.Cells(1) & R.Cells(2)) = R
   
7.         Next
   
8.     End With
   
9.     If D.Count = 0 Then Exit Sub
   
10.     With ListBox1
    
11.         .ColumnCount = 2
    
12.         .List = Application.Transpose(Application.Transpose(D.items))
    
13.     End With
    
14. End Sub

複製代碼

GBKEE

回復 1# yangjie
試試看

1. Sub Ex()
   
2.     Dim D As Object, R As Range
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("基本資料")
   
5.         For Each R In .Range(.Cells(2, 3), .Cells(65536, 4).End(xlUp)).Rows
   
6.             D(R) = ""
   
7.         Next
   
8.     End With
   
9.     If D.Count = 0 Then Exit Sub
   
10.     With ListBox1
    
11.         .ColumnCount = 2
    
12.         .List = Application.Transpose(Application.Transpose(D.keys))
    
13.     End With
    
14. End Sub

複製代碼