返回列表 上一主題 發帖

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

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
1# 跳轉到 »
發表於 2015-11-18 18:20 | 只看該作者

資料搜尋指定由P4到AF25儲存格問題

資料搜尋.rar (14.17 KB)
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儲存格為止請各位指教謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2015-11-19 07:00 | 只看該作者
回復 1# gca78000

是這樣嗎?
  1. For Each A In .Range("P4:AF25")
  2. 'For Each A In .UsedRange
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
3#
發表於 2015-11-19 13:03 | 只看該作者
回復 1# gca78000


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

TOP

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
4#
發表於 2015-11-19 13:39 | 只看該作者
本帖最後由 gca78000 於 2015-11-19 13:42 編輯

回復 3# gca78000 姓氏搜尋.rar (15.52 KB)
請問如下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後卻蒐尋不到請指導謝謝

TOP

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
5#
發表於 2015-11-19 14:09 | 只看該作者
回復 4# gca78000 請問各位
如只要搜尋單姓氏要如何修改請指導謝謝

姓氏搜尋.rar (15.52 KB)

TOP

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
6# 倒序看帖
打印
tT
發表於 2015-11-19 16:44 | 只看該作者

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

姓氏搜尋.rar (15.81 KB)
請問各位高手如下列程式碼如果只要顯示第一個字請問要如何修改內容
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

姓氏搜尋.rar (15.81 KB)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2015-11-20 08:19 | 只看該作者
回復 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) 變數中某數量的字元以其他字串字元替代。

  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"。
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

gca78000

帖子
53 
主題
16 
精華
0 
積分
74 
點名
0  
作業系統
windows xp 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
註冊時間
2010-6-6 
最後登錄
2015-12-10 
8#
發表於 2015-11-20 16:26 | 只看該作者
回復 7# GBKEE
感謝版主用心解答小弟受教了謝謝版大感恩你

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題