• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ado sorgu sonucunu döngüye alma

  • Konbuyu başlatan Konbuyu başlatan acar6783
  • Başlangıç tarihi Başlangıç tarihi
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
hayırlı akşamlar

Kod: 
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
          ThisWorkbook.Path & "\Fatura.xls" & ";extended properties=""excel 12.0;hdr=no"""
        Sorgu = "Select distinct(f3) from [stokkartı$] where f3 not in('" & "Alıcı Depo:" & "','" & "Barkod" & "')"

        Rs.Open Sorgu, Con, 1, 3
      
          stk.Range("A2").CopyFromRecordset Rs

yukarıdaki kodlarda sorgu sonucu oluşan sonuçları sayfaya yapıştırmadan döngüye alıp her sonuç için tekrar farklı bir sorgu yapmam gerekir. Nasıl bir yol izlemem gerekir?
 
Deneyiniz.:cool:
Kod: 
        rs.Open Sorgu, Con, 1, 3
     
          'stk.Range("A2").CopyFromRecordset rs
          rs.movefirst
          Do While Not rs.EOF
            stk.Range("A" & sat).Value = rs(0)
            rs.movenext
          Loop
 
Son düzenleme:
acar6783' Alıntı:
....
..
yukarıdaki kodlarda sorgu sonucu oluşan sonuçları sayfaya yapıştırmadan döngüye alıp her sonuç için tekrar farklı bir sorgu yapmam gerekir. Nasıl bir yol izlemem gerekir?
Genişletmek için tıkla ...


Evren beyin çözümüne alternatif olarak; geri dönen RecordSet'i bir diziye alın, bahsettiğiniz daha sonraki döngüde işinize yarar....

Aşağıdaki satır yerine;

Kod: 
stk.Range("A2").CopyFromRecordset Rs


bunu kullanın....

Kod: 
arrRS = RS.GetRows

Oluşan arrRS dizisi (0) tabanlıdır, ona göre gerekli işlemleri yaparsınız...

.
 
Haluk' Alıntı:
Evren beyin çözümüne alternatif olarak; geri dönen RecordSet'i bir diziye alın, bahsettiğiniz daha sonraki döngüde işinize yarar....

Aşağıdaki satır yerine;

Kod: 
stk.Range("A2").CopyFromRecordset Rs


bunu kullanın....

Kod: 
arrRS = RS.GetRows

Oluşan arrRS dizisi (0) tabanlıdır, ona göre gerekli işlemleri yaparsınız...

.
Genişletmek için tıkla ...


Diziler daha hızlı işlemler ama hala dizilerde yol almış değilim :)

Döngü kurmamım sebebi buradan çıkan sonuçları başka sayfada aratıp olmayanları getirmek olacaktı.Bunu dizi ile yapabilirmiyiz?
 
Cevabı zaten diziye almayla ilgili vermiştim ...

.
 
#4 ncü mesajdaki alıntı size ait.Kime teşekkür ettiniz.:cool:
 
Kod: 
 Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
          ThisWorkbook.Path & "\Faturalaşmayanİrsaliyeler.xls" & ";extended properties=""excel 12.0;hdr=no"""
        Sorgu = "Select distinct(f3) from [stokkartı$] where f3 not in('" & "Alıcı Depo:" & "','" & "Barkod" & "')"

        Rs.Open Sorgu, Con, 1, 3
  Con2.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
          ThisWorkbook.Path & "\stokkartları.xls" & ";extended properties=""excel 12.0;hdr=no"""
   
     Rs.firstnext
          Do While Not Rs.EOF
          Sorgu = "select * from [StokKartı$]where f1 <> Rs(0)"
           Rs2.Open Sorgu, Con2, 1, 3
          If Rs2.RecordCount <> 0 Then
          stk.Range("A" & stk.Cells(Rows.Count, "A").End(3).Row + 1).CopyFromRecordset Rs2
           
            End If
            Rs.movenext
          Loop

Kodları bu şekilde hazırladım ...
 
Son düzenleme:
Eğer referanslardan eklediysenin record seti
Set rs yapmalısınız.
Örnek dosyanızı eklerseniz daha iyi olacak
 
Sorgu içinde sorgu yapmışsınız.Bende hata vermedi.
Bunun yerine innerjoin yaparak işlemi yapabilirsiniz diye düşünüyorum.
Fakat benim innerjoin konusunda fazla bir bilgim yok.
kolay gelsin.
 
Orion1' Alıntı:
Sorgu içinde sorgu yapmışsınız.Bende hata vermedi.
Bunun yerine innerjoin yaparak işlemi yapabilirsiniz diye düşünüyorum.
Fakat benim innerjoin konusunda fazla bir bilgim yok.
kolay gelsin.
Genişletmek için tıkla ...

Başka çözüm bulamadım. Döngü çalışıyor fakat birilyon satırın hepsi doluyor ve baya bir donma oluyor.

Alternatif olarak iki sorguyu diziye alıp çakıştırabilirmiyiz?
 
arr = Range("A1:G1000000").Value gibi yöntem ile diziye almak bellek yetersizliği nedeniyle mümkün değildir. Parça parça almanız gerekir. Örneğin per 50.000
Recordset GetRows ile denemediğim için başarılı olur veya olamaz diyemem.

Yakın bir zamanda kesişim ile ilgili bir başlıkta Excel listesini text dosyalarına aktararak join işlemi uyguladığımızda 7-8 saniyeye kadar düşürmüştük; belki işinize yarayabilir. Konu başlığı : Kapalı Sayfalardan Belirtilen Koşulla Göre Veri Aktarmak.
 
Kod: 
 Sub AKTAR()
Dim a(), b(), c(), d As Object
Dim i As Long, say As Long
With Sheets("STOKKARTI")
If .Cells(Rows.Count, 1).End(3).Row > 2 Then .Range("A3:AG" & .Cells(Rows.Count, 1).End(3).Row).ClearContents
zaman = Timer
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

stkGUMUS = ThisWorkbook.Path & "\stokkartları.xls"
Set wb2 = Workbooks.Open(stk)
mson = wb2.Sheets("StokKartı").Cells(Rows.Count, "A").End(3).Row
a = wb2.Sheets("StokKartı").Range("A1:G" & mson).Value
wb2.Close 0
Faturalaşmayan = ThisWorkbook.Path & "\Faturalaşmayanİrsaliyeler.xls"
Set wb1 = Workbooks.Open(Faturalaşmayan)
eson = wb1.Sheets("stokkartı").Cells(Rows.Count, "A").End(3).Row
b = wb1.Sheets("stokkartı").Range("A6:AG" & eson).Value
wb1.Close 0
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
     
            krt = a(i, 1)
            d(krt) = d(krt) + 1
    Next i

  ReDim c(1 To UBound(b), 1 To 33)
    For i = 1 To UBound(b)
   
        krt = b(i, 3)
        If d(krt) = 0 Then
            say = say + 1
            For s = 1 To 33
            c(say, s) = b(i, s)
            Next
     
        End If
Next i
 
If say > 0 Then

    .[A3].Resize(say, 33) = c
End If

Erase a: Erase b: Erase c
Set d = Nothing: stkGUMUS = Empty: Faturalaşmayan = Empty: Set wb1 = Nothing: Set wb2 = Nothing
say = Empty: mson = Empty: eson = Empty: i = Empty: j = Empty
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
zaman = Empty
End With
End Sub
Yukarıdaki kodlarla istediğimi kısmen elde etmiş durumdayım.

.[A3].Resize(say, 33) = c
buradaki kodlarda nasıl bir değiklik yapmalıyım ki; bana tüm sütunlardaki veriyi A sütununa toplasın?


Kod: 
'="INSERT INTO STKTM010 (STKKOD,STOKAD,KISAAD,GRPNO,CARKOD,SATALNO,TEMBIRIM,BIRAGR,USTBIRIM1,CEVDEG1,USTBIRIM2,CEVDEG2,REYON,ALTREYON,OZELGRUP,URUNTIP,AKDV,TAKDV,SKDV,TSKDV,AKTIF,ITHAL,ETKBIRIM) VALUES ('"&A2&"','"&B2&"','"&C2&"','"&D2&"','"&E2&"','"&F2&"','"&G2&"','"&H2&"','"&I2&"','"&J2&"','"&K2&"','"&L2&"','"&M2&"','"&N2&"','"&O2&"','"&P2&"','"&Q2&"','"&R2&"','"&S2&"','"&T2&"','"&U2&"','"&V2&"','"&G2&"');"

Aslında veriler geldikten sonra bu işlemi yapabilirim ama verileri yapıştırmadan olursa daha iyi olur kanaatindeyim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst