İki rakam arasında sorgu yaptırabilirmiyim.

[blazer2004]

Öncelikle Bütün arkadaşlara ve hocalarıma başarılar.Örnek dosyamda görüldüğü gibi iki farklı rakam arasında kalan verileri çektirmek istiyorum bunu userform'da iki text box'la yapabilirmiyim.Saygılar.

 

[Necdet]

Merhaba,

İki değeri doldurursanız değerler arası bilgiler, başlangıç değerini boş bırakırsanız Bitiş değeri, Bitiş Değerini boş bırakırsanız Başlangıç değerine göre işlem yapar.

Listelenecek değerler Sayfa2 de oluşturulur.

Private Sub CommandButton1_Click()
Dim BasNo   As Long
Dim BitNo   As Long
Dim Sat     As Integer
Dim i       As Integer
Dim s1      As Worksheet
Dim s2      As Worksheet
If TextBox1.Value = "" Then
    BasNo = 0
Else
    BasNo = CLng(TextBox1.Value)
End If
If TextBox2.Value = "" Then
    BitNo = 0
Else
    BitNo = CLng(TextBox2.Value)
End If
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Sat = s2.[A65536].End(3).Row + 1
s2.Range("A2:A" & Sat).ClearContents
Sat = 1
For i = 1 To [A65536].End(3).Row
    If BasNo > 0 And Cells(i, "A") < BasNo Then GoTo Devam
    If BitNo > 0 And Cells(i, "A") > BitNo Then GoTo Devam
    Sat = Sat + 1
    s2.Cells(Sat, "A") = Cells(i, "A")
Devam:
Next i
MsgBox Sat - 1 & " Adet Kayıt Sayfa2'ye Aktarılmıştır...."
End Sub

 

[blazer2004]

Sayın Necdet Yeşertener Hocam elinize sağlık çok güzzel olmuş yalnız rakamlar artarak gittiğinde problem olmuyor ama rakamların yerlerini değiştirdiğim zaman arada kalan satırlar gelmiyor acaba ben bir yerde yanlış yapıyorum.saygılar

 

[Necdet]

Merhaba,

Sayıların sıralı olması gibi bir şart yok, sanırım yanlış giriş yaptınız.

Küçük rakamlarla deneme yapınız, emin olunuz.

 

[blazer2004]

Kusura bakmayın hocam sizi tekrar rahatsız ediyorum. Bir örnek yaptım ve size resim dosyasını gönderiyorum tekrar teşekkür ederim saygılar.

 

[Necdet]

Kusura bakmayın hocam sizi tekrar rahatsız ediyorum. Bir örnek yaptım ve size resim dosyasını gönderiyorum tekrar teşekkür ederim saygılar.

Merhaba, sorunuzun tam olarak ne olduğu anlaşılmıyor, dosyayı resim olarak değil dosyanın kendisini ekleyin ve olması gereken sonucu belirtin ki ne demek istediğinizi tam olarak anlayabilelim.

Örneğin :

1
2
3
4
5
6
2
4
gibi giden değerlerde textbox1 e 3, textbox2 ye de 4 dediğinizde sadece 3 ve 4 değerleri listelenmeyecek mi?

 

[blazer2004]

Sayın Necdet Yeşertener hocam daha önceki gönderdiğim dosyada iki referans arasında kalan sayılar ardışık olduğundan siz onu dikkate aldınız sanırım kusura bakmayın ben arada kalan satırlardan bahsetmek istedim.yani 1,5,8,6,2 diye gidebilir ben texbox1'e 5 yazdım texbox2'ye 2 yazdım bunun arasında kalan satırları getirebilirmisiniz.yani 5,8,6,2 gibi tekrar teşekkürler saygılar.

 

[Necdet]

Merhaba,

Sanırım siz arada kalan her türlü sayıyı aktarmak istiyorsunuz.

Private Sub CommandButton1_Click()
Dim BasNo   As Long
Dim BitNo   As Long
Dim c       As Range
Dim s1      As Worksheet
Dim s2      As Worksheet
If TextBox1.Value = "" Or TextBox2.Value = "" Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Sat = s2.[A65536].End(3).Row + 1
s2.Range("A2:A" & Sat).ClearContents
    Set c = s1.Range("a:a").Find(TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        BasNo = c.Row
    Else
        Exit Sub
    End If
    Set c = s1.Range("a:a").Find(TextBox2.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        BitNo = c.Row
    Else
        Exit Sub
    End If
Range("A" & BasNo & ":A" & BitNo).Copy s2.[A2]
MsgBox BitNo - BasNo + 1 & " Adet Kayıt Sayfa2'ye Aktarılmıştır...."
End Sub

 

[blazer2004]

çok teşekkür ederim necdet hocam yalnız texbox'ları boş geçtiğimizde tüm sayıları getirebilmem için hangi komut satırını ekleyebilirim.Tekrar teşekkür ederim saygılar.

 

[Necdet]

Merhaba,

Private Sub CommandButton1_Click()
Dim BasNo   As Long
Dim BitNo   As Long
Dim c       As Range
Dim s1      As Worksheet
Dim s2      As Worksheet
[COLOR=red][B]'If textbox1.Value = "" Or textbox2.Value = "" Then Exit Sub[/B][/COLOR]
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Sat = s2.[A65536].End(3).Row + 1
s2.Range("A2:A" & Sat).ClearContents
If textbox1.Value = "" Then
    BasNo = 1
Else
    Set c = s1.Range("a:a").Find(textbox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        BasNo = c.Row
    Else
        Exit Sub
    End If
End If
If textbox2.Value = "" Then
    BitNo = [A65536].End(3).Row
Else
    Set c = s1.Range("a:a").Find(textbox2.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        BitNo = c.Row
    Else
        Exit Sub
    End If
End If
Range("A" & BasNo & ":A" & BitNo).Copy s2.[A2]
MsgBox BitNo - BasNo + 1 & " Adet Kayıt Sayfa2'ye Aktarılmıştır...."
End Sub

 

[blazer2004]

Sayın Necdet hocam tekrar teşekkürler ama Texbox'ları boş geçtiğimde işlem yapmıyor Saygılar

 

[Necdet]

Merhaba,

Kodları denemeden acele göndermiştim, önceki mantıktan kalan kontroller vardı, 10. mesajda kodları düzelttim, Kırmızı ile yazılan satırın çıkarılması gerekir.

 

[blazer2004]

Çok teşekkürler Necdet hocam elinize bilginize sağlık saygılar.