Tek bir sayfada arama yaptırma

[aliozturk55]

Merhabalar,
aşağıdaki çalışma kitabı içindeki tüm sayfalardaki hücrelerde arama yapan bir kod var. bunu sayfa ismi yazarak tek bir sayfa da arama yaptırabilir miyiz.

Dim sayfa As Worksheet, Bul As Range, Say As Integer

For Each sayfa In ThisWorkbook.Worksheets
Set Bul = sayfa.Cells.Find(ComboBox1, xlWhole)
If Not Bul Is Nothing Then
Bul.Offset(0, 1) = TextBox4
Bul.Offset(0, 2) = CDbl(TextBox1)
Bul.Offset(0, 3) = TextBox5
Bul.Offset(0, 4) = CDbl(TextBox2)
Bul.Offset(0, 5) = TextBox6
Bul.Offset(0, 6) = CDbl(TextBox3)


Say = Say + 1
End If
Next

 

[Muzaffer Ali]

Merhaba.
Sadece aktif sayfada aramak için.

Sub test()
    Dim Bul As Range, Say As Integer
    Set Bul = Cells.Find(what:=ComboBox1, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
        Bul.Offset(0, 1) = TextBox4
        Bul.Offset(0, 2) = CDbl(TextBox1)
        Bul.Offset(0, 3) = TextBox5
        Bul.Offset(0, 4) = CDbl(TextBox2)
        Bul.Offset(0, 5) = TextBox6
        Bul.Offset(0, 6) = CDbl(TextBox3)
        Say = Say + 1
    End If
End Sub

Belirli bir sayfada aramak için.

Sub test()
    Dim Bul As Range, Say As Integer
    Set Bul = Worksheets("AramaYapılacakSayfaAdı").Cells.Find(what:=ComboBox1, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
        Bul.Offset(0, 1) = TextBox4
        Bul.Offset(0, 2) = CDbl(TextBox1)
        Bul.Offset(0, 3) = TextBox5
        Bul.Offset(0, 4) = CDbl(TextBox2)
        Bul.Offset(0, 5) = TextBox6
        Bul.Offset(0, 6) = CDbl(TextBox3)
        Say = Say + 1
    End If
End Sub

 

[aliozturk55]

çok teşekkür ederim. ellerinize sağlık
birde CDbl(TextBox1) de hiç birşey yazmadığım zaman geçirmiyor. bu nasıl yapabilirim

 

[Muzaffer Ali]

çok teşekkür ederim. ellerinize sağlık
birde CDbl(TextBox1) de hiç birşey yazmadığım zaman geçirmiyor. bu nasıl yapabilirim

Anlamadım.

 

[aliozturk55]

textboxu boş bıraktığımda hata veriyor. ekteki gibi

 

[Muzaffer Ali]

O satırı aşağıdaki ile değiştirin.
if texybox1.text <> "" then Bul.Offset(0, 2) = CDbl(TextBox1)

 

[aliozturk55]

çok çok teşekkür ederim. düzeldi

 

[aliozturk55]

Sn. Dalgalıkur,Son bir sorum daha olacak aşağıdaki kod çalışıyodu dün gece yapmıştım ama şimdi çalışmıyor. kodla yapmak istediğim şu "KASAİCMAL" diye bir sayfam var "H2" hücresinde tarih yazıyor üzerinde değişiklik yaptıktan sonra yan sayfaya kopyalacayacak ismine "H2" hücresindeki tarihi atacak sonrada gizle diyecek. sayfa adı aynı ada rastladığında uyarı verecek ve o kopyaladığı sayfayı silecek bende tarihi düzelttikten sonra yeniden aynı işlemi yapıp kaydedeceğim. umarım karışık anlatmamışımdır.

karışık olduğunu düşünürseniz anlamazsanız beni arayabilirsiniz 0 552 801 55 55 yardımlarınız için şimdiden teşekkür ederim.

Dim Sayfano As String

Sayfano = Sheets("KASAİCMAL").Range("H2")
Sheets("KASAİCMAL").Select
Sheets("KASAİCMAL").Copy Before:=Sheets(24)
Sheets("KASAİCMAL (2)").Select
If Sheets("KASAİCMAL (2)").Name = Sayfano = False Then
Sheets("KASAİCMAL (2)").Name = "silineceksayfa"
MsgBox "Bu kasa yapılmış. Tarihi kontrol ediniz."
GoTo tekrar
End If
Sheets("KASAİCMAL (2)").Name = Sayfano
ActiveWindow.SelectedSheets.Visible = False
tekrar:
Sheets("silineceksayfa").Delete

 

[Muzaffer Ali]

Onun yerine şu kodu kullanın.

    Dim Sayfano As String
    Dim Bak As Worksheet
    Dim SayfaVar As Boolean
    Sayfano = Sheets("KASAİCMAL").Range("H2")
    For Each Bak In Worksheets
        If Bak.Name = Sayfano Then
            SayfaVar = True
            MsgBox "Bu kasa yapılmış. Tarihi kontrol ediniz s."
            Exit Sub
        End If
    Next
    Sheets("KASAİCMAL").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Sayfano
    ActiveSheet.Visible = False

 

[aliozturk55]

harikasınız yaa çok teşekkür ederim.