- Katılım
- 29 Ağustos 2011
- Mesajlar
- 63
- Excel Vers. ve Dili
- 2007
Selam arkadaşlar,
Hazırladığım formda data taraması yapıyorum. Bunun için SEARCH commondbox için aşağıdaki kodları
kullanmaktayım. Sorunum şu ki tarama tam kelimeye göre değil de google sitesindeki gibi harfleri yazdıkça taramaya başlaması şeklinde olması daha çok işime yarayacak. Bu nedenle user form üzerinde SEARCH commondbox ına ihtiyaç olmaksızın textbox a yazdığım anda taramaya başlayan bir model için aşağıdaki kodu nasıl modifiye edebilir. örnek çalışma ekte
İyi çalışmalar
Hazırladığım formda data taraması yapıyorum. Bunun için SEARCH commondbox için aşağıdaki kodları
kullanmaktayım. Sorunum şu ki tarama tam kelimeye göre değil de google sitesindeki gibi harfleri yazdıkça taramaya başlaması şeklinde olması daha çok işime yarayacak. Bu nedenle user form üzerinde SEARCH commondbox ına ihtiyaç olmaksızın textbox a yazdığım anda taramaya başlayan bir model için aşağıdaki kodu nasıl modifiye edebilir. örnek çalışma ekte
İyi çalışmalar
Private Sub CommandButton1_Click()
'SEARCH
Dim Cnt As Long
Dim Col As Variant
Dim FirstAddx As String
Dim FoundMatch As Range
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Dim S1 As Worksheet
Set S1 = Sheets("Sheet1")
StartRow = 2
Col = ComboBox1.ListIndex + 1
If Col = 0 Then
MsgBox "Please choose a category."
Exit Sub
End If
If TextBox1.Text = "" Then
MsgBox "Please enter a search term."
TextBox1.SetFocus
Exit Sub
End If
LastRow = S1.Cells(Rows.Count, Col).End(xlUp).Row
LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
Set Rng = S1.Range(S1.Cells(2, Col), S1.Cells(LastRow, Col))
Set FoundMatch = Rng.Find(What:=TextBox1.Text, _
After:=Rng.Cells(1, 1), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FoundMatch Is Nothing Then
FirstAddx = FoundMatch.Address
ListView1.ListItems.Clear
Do
Cnt = Cnt + 1
R = FoundMatch.Row
ListView1.ListItems.Add Index:=Cnt, Text:=R
For Col = 1 To 13
Set C = S1.Cells(R, Col)
ListView1.ListItems(Cnt).ListSubItems.Add Index:=Col, Text:=C.Text
Next Col
Set FoundMatch = Rng.FindNext(FoundMatch)
Loop While FoundMatch.Address <> FirstAddx And Not FoundMatch Is Nothing
SearchRecords = Cnt
Else
ListView1.ListItems.Clear
SearchRecords = 0
MsgBox "No match found for " & TextBox1.Text
End If
End Sub
Private Sub UserForm_Activate()
Dim C As Long
Dim I As Long
Dim R As Long
Dim S1 As Worksheet
Set S1 = Sheets("Sheet1")
ListView1.View = lvwReport
ListView1.HideSelection = False
ListView1.FullRowSelect = True
ListView1.HotTracking = True
ListView1.HoverSelection = False
ListView1.ColumnHeaders.Add Text:="Row", Width:=64
For C = 1 To 13
ListView1.ColumnHeaders.Add Text:=S1.Cells(1, C).Text
ComboBox1.AddItem S1.Cells(1, C).Text
Next C
'For R = 2 To 21
' ListView1.ListItems.Add Index:=R - 1, Text:=Str(R)
' For C = 1 To 13
' ListView1.ListItems(R - 1).ListSubItems.Add Index:=C, Text:=Cells(R, C).Text
' Next C
'Next R
End Sub
Ekli dosyalar
-
67.5 KB Görüntüleme: 100
Son düzenleme: