Userform üzerinden ayrı sütunlara göre veri search yapma

[nirvanarapeme]

Selam arkadaşlar,

Yabancı sitenin birinde userform üzerinden sheet deki ayrı sütunlara göre tarama yapan güzel bir çalışma buldum. Ekteki dosyada da göreceğiniz gibi search yapacağımız userform a erişmek için sheet1 içerisinde "search" adında bir buton konulmuş. Sorunum şu; ben bu userform a "search" butonuna basmadan direk ulaşmak istiyorum. Ancak koda sheet1 içerisindeki veriyi taraması için bi kaç kod daha eklemem gerekecek sanırım. Amacım verilerimin olduğu sayfanın tarama yaparken görülmemesi. Bu konuda yardımcı olabilir misiniz. İyi geceler

 

[nirvanarapeme]

Yani kısacası aşağıdaki kodun Sheet1 adlı sayfada tarama yapmasını sağlamam gerekiyor. Kodun biryerinde Sheet1 ifadesini yazmam gerekiyor ama nasıl yazacağımı bilmiyorum arkadaşlar...

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

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 = Cells(Rows.Count, Col).End(xlUp).Row
LastRow = IIf(LastRow < StartRow, StartRow, LastRow)

Set Rng = Range(Cells(2, Col), 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 = 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

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:=Cells(1, C).Text
ComboBox1.AddItem 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

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki gibi deneyiniz.

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