Aynı Sorgunun 2 sonucu bulma

[hlojan]

Access Veritabanından bir sorgu yapmak için bunu kullanıyorum

'*************************************************************
'********************CİHAZ BULMA***************************
'*************************************************************
Dim con As Object, rs As Object

Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Data").Range("t4").Value & "' and sira=" & CDbl(Worksheets("Data").Range("T6").Value) & ";", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
Worksheets("Data").Range("t13").Value = ""
Worksheets("Data").Range("t14").Value = ""
Worksheets("Data").Range("t15").Value = ""
Worksheets("Data").Range("t16").Value = ""
Worksheets("Data").Range("t13").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t14").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t15").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t16").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing

Aradığım sorgudan 2 tane recordset varsa bir sonraki rs yi görmek için bir çözüm var mı?

Command Buttona Her tıkladığımda yukardaki sorgudan bulduğu bir sonraki bir sonraki recordseti gösterse.

Yardımarınızı bekliyorum

 

[alicimri]

Sayın hlojan
Varsayılan olarak Command Button un caption una Sql1 yazın
koddaki "....." olan yere de ikinci sql komutunu yazın

Private Sub CommandButton1_Click()
If CommandButton1.Caption = "Sql1" Then
Sql = "select * from [A] where kod='" & Worksheets("Data").Range("t4").Value & "' and sira=" & CDbl(Worksheets("Data").Range("T6").Value) & ";"
CommandButton1.Caption = "Sql2"
Else
Sql = "...................."
CommandButton1.Caption = "Sql1"
End If
Dim con As Object, rs As Object

Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open Sql, con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
Worksheets("Data").Range("t13").Value = ""
Worksheets("Data").Range("t14").Value = ""
Worksheets("Data").Range("t15").Value = ""
Worksheets("Data").Range("t16").Value = ""
Worksheets("Data").Range("t13").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t14").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t15").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t16").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing
End Sub

 

[alicimri]

Sayın hlojan
Sorunuzu tekrar okuyunca Şüpheye düştüm.

sorgudan 2 tane recordset varsa

derken "recordset te iki kayıt varsa" mı demek istiyorsunuz. O zaman çözüm (rs.movenext) ile olacak

 

[hlojan]

aynen 2 tane benzer recordset var. rs.movenext tek button ile kullanabilirmiyim. Nereye koyacağım tam olarak

 

[Erdem Akdemir]

Örnek bir dosya ekleyebilir misiniz?

Daha hızlı cevap alabilirsiniz.
Çözüm sunacak olanlar, birde örnek dosya hazırlamak zorunda kalmasın.

 

[hlojan]

Hemen bir örnek hazırladım

 

[Necdet]

Merhaba,
Döngü ile teker teker alabilirsiniz.

    i = 1
    RS.MoveFirst
    Do
        i = i + 1
        MsgBox "Sıra No : " & i & " " & RS![Proje Kodu] & " " & RS![Proje Adı]
        RS.MoveNext
    Loop Until RS.EOF

 

[hlojan]

Msgbox ile sırayla veriyor. Denedim oldu.

Hücreye uyguladığımda olmuyor. Cünkü bütün recordsetleri gösterip sonuncusunda kalıyor

Her commandbuttona tıkladığımda bi sonraki rs ye geçmesi gerekir.

Ama uyguladığım komut sonunda rs.close yaptığımızdan hangi recordsette kalıp devam edeceğimizi algılayamaz.

Aklıma şöyle bir çözüm geldi. Not:

ilk tıklamamda move first sadece
Range("a2").Value =rs("teklif")
2. tıklamam
a2 hücresindeki değerin rs deki sırasını aldılasın
move next yapsın

3. 4 .5 devam etsin

Çok karmaşık oldu galiba. Yardımlarınızı bekliyorum

 

[Necdet]

Merhaba,

yukarıda verdiğim döngü ile diziye alıp, istediğiniz gibi diziden işlem yapabilirsiniz.

 

[alicimri]

Msg Box da İstediğiniz kayıta gelene kadar "Hayır" a basın.
İstediğiniz Kayıta gelince Evet e basın kayıt yapsın.
Vazgeçerseniz iptal e basın.
Ben Msg Box da sadece Markayı yazdırdım diğerlerini siz ilave edin

Dim con As Object, rs As Object
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Data").Range("t4").Value & "' and sira=" & CDbl(Worksheets("Data").Range("T6").Value) & ";", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
say = rs.RecordCount
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Style = vbYesNoCancel
Title = "Kayıt Seç"
Response = MsgBox(rs("marka"), Style, Title)
If Response = vbNo Then
For i = 1 To say - 1
ys.MoveNext
 Response = MsgBox(rs("marka"), Style, Title)
Next
ElseIf Response = vbYes Then
Worksheets("Data").Range("t13").Value = ""
Worksheets("Data").Range("t14").Value = ""
Worksheets("Data").Range("t15").Value = ""
Worksheets("Data").Range("t16").Value = ""
Worksheets("Data").Range("t13").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t14").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t15").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
Worksheets("Data").Range("t16").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))
End If
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing