Kitapta arama yapma

[alperalper]

Aşağıdaki çalışmaya bi göz atın arkadaşlar. Arama yapmak istediğim yerleri işaretledim.

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[alperalper]

Arama olarak olmuş ama listboxta çıkan sonuçlara çift tıkladığım zaman o verinin olduğu sayfadaki A1 hücresine gitmiyor. Birde yurt no ile oda numarasını aynı hücrede arasın. Sanırım oda numarasını aramıyor.

 

[Ferhat Pazarçevirdi]

Arama olarak olmuş ama listboxta çıkan sonuçlara çift tıkladığım zaman o verinin olduğu sayfadaki A1 hücresine gitmiyor.

Bunun için aşağıdaki kodu userformun kod sayfasına kopyalayınız.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Sheets(ListBox1.Value).Select
Range("A1").Select
End Sub

Birde yurt no ile oda numarasını aynı hücrede arasın.

Bunu anlamadım....

Sanırım oda numarasını aramıyor.

Oda numarasını arıyor ama mesaj içeriği başka birşey miş gibi görünüyor. Lütfen, ilgili kodu silerek aşağıdakini kullanınız.

Private Sub CommandButton4_Click()
ListBox1.Clear
For i = 1 To Sheets.Count
  Set sh = Sheets(i)
   If Not IsNumeric(sh.Name) Then: GoTo 10
   If IsNumeric(TextBox4.Value) Then
     If sh.Cells(12, 3) = TextBox4.Value * 1 Then
        With ListBox1
           .AddItem sh.Name
           .List(.ListCount - 1, 1) = sh.Cells(11, 3)
           .List(.ListCount - 1, 2) = sh.Cells(20, 5)
           .List(.ListCount - 1, 3) = sh.Cells(19, 5)
           .List(.ListCount - 1, 4) = sh.Cells(24, 5)
        End With
     End If
   End If
10
  Set sh = Nothing
Next i
If ListBox1.ListCount = 0 Then: MsgBox "Oda No : " & TextBox4.Text & vbCrLf & "Kriterine uygun herhangi bir kayıt bulunamadı", vbCritical, "Kayıt yok": Label6.Caption = "Uyumlu veri yok"
Label6.Caption = ListBox1.ListCount & " adet kayıt bulundu"
End Sub

 

[alperalper]

Arkadaşlar şu userforumu bir türlü ayarlayamadım. Allah rızası için bi bakın çok acil. Dört farklı kriterde arama yapmak istiyorum. Çıkan sonuca çift tıkladığımda o sayfaya gitsin tamam.. Bütün işlem bu kadar.. Arkadaşlar yardımlarınızı bekliyorum..

 

[Korhan Ayhan]

Selamlar,

Formunuzdaki tüm kodları silip aşağıdaki kodları uygularmısınız.

Private Sub CommandButton1_Click()
    If TextBox1 <> "" Then
    ListBox1.Clear
    For X = 2 To Sheets.Count
    If Sheets(X).[C11] = Val(TextBox1) Then
    ListBox1.AddItem
    ListBox1.List(Sat&#305;r, 0) = Sheets(X).Name
    ListBox1.List(Sat&#305;r, 1) = Sheets(X).[C11]
    ListBox1.List(Sat&#305;r, 2) = Sheets(X).[C12]
    ListBox1.List(Sat&#305;r, 3) = Sheets(X).[E20]
    ListBox1.List(Sat&#305;r, 4) = Sheets(X).[E19]
    ListBox1.List(Sat&#305;r, 5) = Sheets(X).[E24]
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    End If
End Sub

Private Sub CommandButton2_Click()
    If TextBox2 <> "" Then
    ListBox1.Clear
    If IsNumeric(TextBox2) Then
    For X = 2 To Sheets.Count
    If Sheets(X).[E19] = Val(TextBox2) Then
    ListBox1.AddItem
    ListBox1.List(Sat&#305;r, 0) = Sheets(X).Name
    ListBox1.List(Sat&#305;r, 1) = Sheets(X).[C11]
    ListBox1.List(Sat&#305;r, 2) = Sheets(X).[C12]
    ListBox1.List(Sat&#305;r, 3) = Sheets(X).[E20]
    ListBox1.List(Sat&#305;r, 4) = Sheets(X).[E19]
    ListBox1.List(Sat&#305;r, 5) = Sheets(X).[E24]
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    End If
    If Not IsNumeric(TextBox2) Then
    For X = 2 To Sheets.Count
    If Evaluate("=UPPER(""" & Sheets(X).[E20] & """)") = Evaluate("=UPPER(""" & TextBox2 & """)") Then
    ListBox1.AddItem
    ListBox1.List(Sat&#305;r, 0) = Sheets(X).Name
    ListBox1.List(Sat&#305;r, 1) = Sheets(X).[C11]
    ListBox1.List(Sat&#305;r, 2) = Sheets(X).[C12]
    ListBox1.List(Sat&#305;r, 3) = Sheets(X).[E20]
    ListBox1.List(Sat&#305;r, 4) = Sheets(X).[E19]
    ListBox1.List(Sat&#305;r, 5) = Sheets(X).[E24]
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    End If
    End If
End Sub

Private Sub CommandButton3_Click()
    If TextBox3 <> "" Then
    ListBox1.Clear
    For X = 2 To Sheets.Count
    If Sheets(X).[C12] = Val(TextBox3) Then
    ListBox1.AddItem
    ListBox1.List(Sat&#305;r, 0) = Sheets(X).Name
    ListBox1.List(Sat&#305;r, 1) = Sheets(X).[C11]
    ListBox1.List(Sat&#305;r, 2) = Sheets(X).[C12]
    ListBox1.List(Sat&#305;r, 3) = Sheets(X).[E20]
    ListBox1.List(Sat&#305;r, 4) = Sheets(X).[E19]
    ListBox1.List(Sat&#305;r, 5) = Sheets(X).[E24]
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    End If
End Sub

Private Sub CommandButton4_Click()
    If ComboBox1 <> "" Then
    ListBox1.Clear
    For X = 2 To Sheets.Count
    If Sheets(X).[E24] = ComboBox1 Then
    ListBox1.AddItem
    ListBox1.List(Sat&#305;r, 0) = Sheets(X).Name
    ListBox1.List(Sat&#305;r, 1) = Sheets(X).[C11]
    ListBox1.List(Sat&#305;r, 2) = Sheets(X).[C12]
    ListBox1.List(Sat&#305;r, 3) = Sheets(X).[E20]
    ListBox1.List(Sat&#305;r, 4) = Sheets(X).[E19]
    ListBox1.List(Sat&#305;r, 5) = Sheets(X).[E24]
    Sat&#305;r = Sat&#305;r + 1
    End If
    Next
    End If
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex < 0 Then Exit Sub
    Sheets(ListBox1.Column(0)).Select
    [A1].Select
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
    .Clear
    .ColumnCount = 6
    .ColumnWidths = "36;42;42;78;78;60"
    End With
    With ComboBox1
       .AddItem "A Rh(-)"
       .AddItem "A Rh(+)"
       .AddItem "B Rh(-)"
       .AddItem "B Rh(+)"
       .AddItem "AB Rh(-)"
       .AddItem "AB Rh(+)"
       .AddItem "0 Rh(-)"
       .AddItem "0 Rh(+)"
    End With
End Sub

 

[alperalper]

Eyvallah COST_CONTROL çok teşekkür ederim beni büyük sıkıntıdan kurtardın..

 

[Berk Kaan]

arkadaşlar Simgelerde kelimenin köşesine rakam yazmak istiyorum bana yardımcı olurmusunuz