顯示第一個字請問要如何修改內容

gca78000

資料搜尋.rar (14.17 KB)

如附件
下載次數: 5

2015-11-18 18:16

Private Sub ComboBox1_Change()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
.Cells.Interior.ColorIndex = xlNone
For Each A In .UsedRange
  If A = ComboBox1.Text Then d(A.Address(0, 0, xlA1)) = "": A.Interior.ColorIndex = 6
Next
End With
Unload Me

End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Click()
End Sub

Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
For Each A In .UsedRange
   If A <> "" Then d(A.Value) = ""
Next
Label1.Caption = .Name
.Cells.Interior.ColorIndex = xlNone
End With
ComboBox1.List = d.keys
End Sub

指定只從P4搜尋到AF25儲存格為止請各位指教謝謝

GBKEE

回復 1# gca78000

是這樣嗎?

1. For Each A In .Range("P4:AF25")
   
2. 'For Each A In .UsedRange

複製代碼

gca78000

回復 1# gca78000


    謝謝大大指導小弟煩請在指導一下
如只要尋P4:P25及R4到R25及T4到T25及V4到V25
要如何改請指導謝謝

gca78000

回復 3# gca78000 姓氏搜尋.rar (15.52 KB)

下載次數: 1

2015-11-19 13:39

請問如下Private Sub ComboBox1_Change()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
.Cells.Interior.ColorIndex = xlNone
For Each A In .Range("P4:P25,R4:R25,T4:T25,V4:V25")

  If A = ComboBox1.Text Then d(A.Address(0, 0, xlA1)) = "": A.Interior.ColorIndex = 6
Next
End With
Unload Me

End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Click()
End Sub

Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
For Each A In .Range("P4:P25,R4:R25,T4:T25,V4:V25")

   If A <> "" Then d(A.Value) = ""
Next
Label1.Caption = .Name
.Cells.Interior.ColorIndex = xlNone
End With
ComboBox1.List = d.keys
End Sub
P4:P25可搜尋到而R4:R25後卻蒐尋不到請指導謝謝

gca78000

回復 4# gca78000 請問各位
如只要搜尋單姓氏要如何修改請指導謝謝

gca78000

姓氏搜尋.rar (15.81 KB)

下載次數: 2

2015-11-19 16:42

請問各位高手如下列程式碼如果只要顯示第一個字請問要如何修改內容
Private Sub ComboBox1_Change()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
.Cells.Interior.ColorIndex = xlNone
For Each A In .Range("P4:P25,R4:R25,T4:T25,V4:V25")

  If A = ComboBox1.Text Then d(A.Address(0, 0, xlA1)) = "": A.Interior.ColorIndex = 6
Next
End With
Unload Me

End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Click()
End Sub

Private Sub UserForm_Initialize()
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
For Each A In .Range("P4:P25,R4:R25,T4:T25,V4:V25")

   If A <> "" Then d(A.Value) = ""
Next
Label1.Caption = .Name
.Cells.Interior.ColorIndex = xlNone
End With
ComboBox1.List = d.keys
End Sub

GBKEE

回復 6# gca78000


試試看

1. Option Explicit
   
2. Dim d As Object, Rng As Range  '私用變數,僅這模組可用
   
3. Private Sub UserForm_Initialize()
   
4.     Dim A As Range, M As String
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("查詢區")
   
7.         Set Rng = .Range("P4:P25,R4:R25,T4:T25,V4:V25")
   
8.         Label1.Caption = .Name
   
9.         .Cells.Interior.ColorIndex = xlNone
   
10.     End With
    
11.     For Each A In Rng
    
12.         M = Mid(A, 1, 1)
    
13.         If M <> "" Then
    
14.             If d.exists(M) Then   '字典物件的Key存在(已使用)
    
15.                 Set d(M) = Union(A, d(M))  'Set:設定為物件 , A As Range
    
16.             Else
    
17.                 Set d(M) = A
    
18.             End If
    
19.         End If
    
20.     Next
    
21.     ComboBox1.List = d.keys
    
22. End Sub
    
23. Private Sub ComboBox1_Change()
    
24.     Rng.Interior.ColorIndex = xlNone
    
25.     d(ComboBox1.Text).Interior.ColorIndex = 6
    
26. End Sub

複製代碼

vba的說明

1. Mid 陳述式 將一 Variant (String) 變數中某數量的字元以其他字串字元替代。
   
2. 
   
3. Mid 陳述式範例
   
4. 本範例使用 Mid 陳述式將某字串中的幾個字元置換為其它的字元。
   
5. Dim MyString
   
6. MyString = "The dog jumps"    ' 設定字串初值。
   
7. Mid(MyString, 5, 3) = "fox"    ' MyString = "The fox jumps"。
   
8. Mid(MyString, 5) = "cow"    ' MyString = "The cow jumps"。
   
9. Mid(MyString, 5) = "cow jumped over"    ' MyString = "The cow jumpe"。
   
10. Mid(MyString, 5, 3) = "duck"    ' MyString = "The duc jumpe"。

複製代碼

gca78000

回復 7# GBKEE
感謝版主用心解答小弟受教了謝謝版大感恩你