• DİKKAT

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

accese veri yüklemenin en hızlı yolu

  • 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,
Aşağıdaki kodlarla accese veri silip yüklüyorum
Aslında şu an için deneme amaçlı 5500 satır var ve hızlı diye düşünüyorum fakat veri sayısı yaklaşık 500.000adet olduğunda bu kadar hızlı olmayacağı kanaatindeyim.

Bu konuda nasıl hızlandırma yapabiliriz?
Kod: 
Sub accessil()
Dim con As Object, rs As Object, Sorgu As String
    
    Set con = CreateObject("Adodb.Connection")
    Set con2 = CreateObject("Adodb.Connection")
    Set rs = CreateObject("Adodb.RecordSet")
    Set rs2 = CreateObject("Adodb.RecordSet")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
          ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=NO"""
        Sorgu = "Select distinct(f1),F2 from [OracleRapor$] where f1 " & _
        "not in('" & "Gidkalem:<Tümü>" & "','" & "YIL" & "') AND not isnull(f1) "
        rs.Open Sorgu, con, 1, 3
        If rs.RecordCount > 0 Then
        yol = Left(ThisWorkbook.Path, InStr(ThisWorkbook.Path, "\Kullanıcılar")) & "\VeriTabanı" & "\Veritabanı.mdb"
        con2.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
 
rs.movefirst
 Do While Not rs.EOF

  Sorgu2 = "SELECT * FROM GiderRaporu WHERE YIL = '" & rs(0) & "' and AY = '" & rs(1) & "' "
rs2.Open Sorgu2, con2, 1, 3
        If rs2.RecordCount > 0 Then
rs2.movefirst
Do While Not rs2.EOF
rs2.Delete
  rs2.Update
rs2.movenext

Loop
End If
SAY = rs2.RecordCount
rs2.Close

rs.movenext
Loop
End If
  MsgBox SAY & Chr(13) & " Eski Veriler Silinmiştir!!!", vbInformation, "Bilgi"

rs.Close: con.Close
Set rs = Nothing: Set con = Nothing: i = Empty
Set rs2 = Nothing: Set con2 = Nothing: SAY = Empty
End Sub


Kod: 
Sub accesegönder()

Set con = CreateObject("Adodb.Connection")
    Set rs = CreateObject("Adodb.RecordSet")
    Set Op = Sheets("OracleRapor")

SAY = 0
dosya_yolu = Left(ThisWorkbook.Path, InStr(ThisWorkbook.Path, "\Kullanıcılar")) & "\VeriTabanı"
yol = dosya_yolu & "\Veritabanı.mdb"

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""

  Sorgu = "SELECT * FROM [GiderRaporu] "
'On Error GoTo uyarı
rs.Open Sorgu, con, 1, 3
        If rs.RecordCount >= 0 Then
For i = 6 To Op.Cells(Rows.Count, "A").End(3).Row

If Op.Cells(i, "A") <> "YIL" And Op.Cells(i, "A") <> "Gidkalem:<Tümü>" Then
 

SAY = SAY + 1
 rs.ADDNEW

   For stn = 1 To 7
    yenideğer = Op.Cells(i, stn)
If yenideğer = " " Then yenideğer = Null
rs(stn - 1).Value = yenideğer
 rs(7).Value = Op.Cells(i, 9)

        Next
          rs.Update
          End If
            
            Next
rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: Sorgu = ""

MsgBox SAY & " Adet BA Formu Aktarılmıştır !!!", vbInformation, "BA Form"
Else
MsgBox "Hata"
 Exit Sub

End If
End Sub
 
Haluk' Alıntı:
Daha önceki konu başlığında yer alan metodu denediniz mi?

https://www.excel.web.tr/threads/ka...osulla-goere-veri-aktarmak.174964/post-981498

Ayrıca, Zeki Beyin de bu konuyla ilgili bir çok mesajı vardı forumda...

.
Genişletmek için tıkla ...
Deneme yapamadım çünkü anladığım kadarıyla kodlar sıfırdan tablo oluşturuyor. Bendeki dosyada halihazırda tablo mevcut.Bu tablo üzerinde yazıp silme işlemleri yapma gerekiyor. yapıyorum da fakat az önce tekrar deneme yaptım. 38.000kayıt baya yavaş çalıştı. Dosya kilitlendi.
 
Kod: 
Sub accessyükle()
Dim con As Object
Set con = CreateObject("Adodb.conion")


con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;" & "Persist Security Info=False"
con.Execute "INSERT INTO GiderRaporu IN 'C:\Users\dell\Desktop\GiderDosyası\VeriTabanı\VeriTabanı.mdb' SELECT * FROM [OracleRapor$]"

con.Close
Set con = Nothing
End Sub

Yüklemek için kodlarımı revize ettim.Silme ile ilgili cevaplarınızı bekliyorum.

Silme kodlarındaki mantık ;
İlgili sayfadaki 1 ve 2. sütunlardaki benzersiz kayıtları accces tablosunda taratıp sildirmek.
 
En hızlı bu şekilde tasarladım.
115.387 kaydı 7 saniyede yükleyip koşula bağlı silme işlemi14 saniyede gerçekleşiyor.

Kod: 
Sub accessil2()
    Dim dict As Object, hücre As Range
    Dim con, rs As Object
    Z = TimeValue(Now)
     Set con = CreateObject("Adodb.Connection")
     Set rs = CreateObject("Adodb.RecordSet")
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
     yol = Left(ThisWorkbook.Path, InStr(ThisWorkbook.Path, "\Kullanıcılar")) & "\VeriTabanı" & "\Veritabanı.mdb"
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
    
    With Sheets("OracleRapor")
        For Each hücre In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            dict.Item(hücre.Value & "|" & hücre.Offset(, 1).Value) = Empty
              
        Next hücre
    
    End With
        
    With Sheets("Sayfa4")
        '.Range("A1").Resize(dict.Count).Value = Application.Transpose(dict.keys)
        For Each Key In dict.keys
        
         Sorgu2 = "DELETE * FROM GiderRaporu WHERE YIL & '" & "|" & "' & AY = '" & Key & "' "

con.Execute (Sorgu2)
        Next
    con.Close
Set Sorgu2 = Nothing: Set con = Nothing: i = Empty
    End With
   MsgBox CDate(TimeValue(Now) - Z), vbInformation
End Sub
Sub accessyükle()
Dim con As Object
Set con = CreateObject("Adodb.conNECTion")


con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;" & "Persist Security Info=False"
con.Execute "INSERT INTO GiderRaporu IN 'C:\Users\dell\Desktop\GiderDosyası\VeriTabanı\VeriTabanı.mdb' SELECT * FROM [OracleRapor$]"

con.Close
Set con = Nothing
End Sub
 
Merhaba.
Birde compact_3.5_sql server deneyin.4 gb veri alıyor.Ve accessten daha hızlı olduğu söyleniyor.Ben bununla program yaptım ama hızını denemedim.İyi geceler
 
Kod: 
"DELETE * FROM GiderRaporu WHERE YIL & '|' & AY IN (" & join(dict.keys,",") & ")"
gibi joinle deneyin, verileriniz çok fazla çalışır mı bilmem,
en sağlıklısı insert into daki gibi where içinde bir alt sorgu yapmak
örnek eklerseniz çözmeye çalışırız.
 
veyselemre' Alıntı:
Kod: 
"DELETE * FROM GiderRaporu WHERE YIL & '|' & AY IN (" & join(dict.keys,",") & ")"
gibi joinle deneyin, verileriniz çok fazla çalışır mı bilmem,
en sağlıklısı insert into daki gibi where içinde bir alt sorgu yapmak
örnek eklerseniz çözmeye çalışırız.
Genişletmek için tıkla ...

Buradaki join işlevine işe yarıyor tam olarak?
Dönügüyü kaldırdım belki döngüsüz silme işlemi olacak diye, fakat olmadı .
 
join WHERE koşul IN için dictionary içine attığınız verilerden bir array oluşturmak için en fazla 65336 eleman için çalışır, ama test etmek lazım, çalışıp çalışmayacağını bilmiyorum, oluşan stringi kontrol etmek lazım, belki tek tırnak içine aldırmak da gerekebilir.
 
acar6783' Alıntı:
For Each Key In dict.keys Sorgu2 = "DELETE * FROM GiderRaporu WHERE YIL & '" & "|" & "' & AY = '" & Key & "' " con.Execute (Sorgu2) Next
Genişletmek için tıkla ...
Burada sorguda oluşan kayıtları nasıl saydırabilirim?
aynı şekilde burada da;

Con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;" & "Persist Security Info=False" Con.Execute "INSERT INTO GiderRaporu IN '" & yol & "' SELECT * FROM [Gider$] where not isnull(YIL)"
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst