Excelden Veri Alma Ve Kaydı Güncelleme

(06/02/2020, 23:55)berduş yazdı: Bu arada ufak bir not duseyim:
2 yöntem arsındaki hız farkı çok fazla Excel dosyasına 3000 kayıt ekleyip denedim
Tek tek kayıtları ekleyip güncellendiğinde 1 dk 50 sn
Diğer yöntemde ise sadece 15sn sürüyor tüm işlem.

İkincide zaten döngü yok ondan hızlı Yinede bence konuyu açan üstadın istediği gibi değil bence.
Olmayan kayıt için en altlarda çıkmalı sanki.

Ama bence süper kodlar mevcut dosyada.

3000 satırlık dosyada update ile yaptığım ne kadar sürüyor?

Yarın 3 yöntemi de tek tek deneyip sonucu yazarım, gerekirse dosyayı da eklerim. Ama bence sıralama okadar da önemli değil. Sonucun doğruluğu ve hız önemli ama dediginiz gibi sayin @yahyamacit karar verecek ben sadece kendi önerimi belirtebilirim.

Tamam.

Yalnız şöyle bir durum var alttaki gib sadece güncelleme için kodu alttaki gibi yaptım yani addnew yerini kaldırdım ve hata oluştu.
Normalde  tabloya yazdıklarım göncellenmeliydi.

Do While Not rs.EOF And Not rs.BOF 'Tablo güncelleme icin(Exceldeki recordseti icine alinan veriler icin döngü)

      SrgK = " select * from tablo1 where [kod]='" & Replace(rs(0), "'", "''") & "'"

      rsK.Open SrgK, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

      If rsK.RecordCount = 0 Then 'rsK.MoveFirst

            rsK(1) = rs(1)

            rsK(2) = rs(2)

            rsK(3) = rs(3)

            rsK.Update

            say = say + 1

      End If

      rsK.Update

      rsK.Close

      rs.MoveNext

        DoEvents

      

      Me.ProgressBar3.Value = ((say + say1) / adet) * 100

      Me.lbyzde.Caption = Int(Me.ProgressBar3.Value) & " %"

    

    Loop

Hata verdiği yer kaydın olmadığı bir kayıt, o durumda addNew yapmazsanız hata verir. Olmayan kaydı gunceleyemezsiniz önce add new ile eklemelisiniz.

h"ali'ş kaydının kodu ne?

Sizin şu hızlı çalışan koda ekleme yapıp ve biraz değiştirdim.
Artık altlarda çıkıyor önceden yazdığım olay


Dim kopyala
kopyala = Format(Now(), "dd_mm_yyyy_hh_mm_ss") & "_Tablo1"

DoCmd.CopyObject , kopyala, acTable, "Tablo1"

CurrentDb.Execute " delete from tablo1"
CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _
                  " SELECT KOD, AD, yas, tarih " & _
                  " FROM " & kopyala & " where [KOD] Is Not Null"
DoCmd.DeleteObject acTable, kopyala

Üstteki kodlarla yaptım işlemi.Özetle Tablo1 in formatlı isim olarak frmatlı kopyalattım.
Bu tabloyada excelde olup tablo1 de olmayanları aktardım.
Sonrada bağlantı ile alınan exceldeki verileri tablo1e aktardım sonundada kopyala değişkeniyle alınan tablodakileri tablo1 e aktarınaca en alta atmış oldu.Ve oluşturulan tablo silindi.


Kodların tamamı altta.

Option Compare Database

  

Private Sub Form_Current()

    lbyzde.Visible = False

End Sub



Private Sub Komut6_Click()

'hy_Geçici_tablo_var_mý_varsa_sil_____

  If Not IsNull(DLookup("Name", "MSysObjects", "Name='TmpTablo'")) Then DoCmd.DeleteObject acTable, "TmpTablo"

'hy_tablo_kontrol____________________Bitti

    

    Dim varFile As Variant

    Dim yahya As String

    Dim fDialog As Office.FileDialog



'Dosya ac -------------------------------------------------------------------------------------------------------

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)



  With fDialog

      .AllowMultiSelect = False

        .Title = "Lütfen Aktaraca?ynyz Bilgilerin Bulundu?u Excel Dosyasyny Seçin"



        .Filters.Clear

        .Filters.Add "All Files", "*.*"

        .Filters.Add "Excel 2003", "*.xls"

        .Filters.Add "Excel 2007", "*.xlsx"





          If .Show = True Then

            For Each varFile In .SelectedItems

                yahya = varFile

            Next

        End If

    End With



    If yahya = "" Or IsNull(yahya) Then

        MsgBox "Dosya secilmedigi icin iptal edildi...", vbCritical, "iptal"

        Set fDialog = Nothing

        Exit Sub

    End If

    

    Me.ProgressBar3.Visible = True

    Me.lbyzde.Visible = True

    Me.lbyzde.Top = Me.ProgressBar3.Top + 10

    Me.lbyzde.Left = (Me.ProgressBar3.Left + 10) + Me.ProgressBar3.Width

    

  'Dosya ac sonu -------------------------------------------------------------------------------------------------------

  





DoCmd.TransferSpreadsheet TransferType:=acLink, _

                          TableName:="TmpTablo", _

                          SpreadsheetType:=10, _

                          FileName:=yahya, _

                          HasfieldNames:=True, _

                          Range:="B3:E" '"Hy bin 2!B3:E"



'hy Tablo Boþ Mu_____________

Dim SayRS As New ADODB.Recordset

Dim SaySql As String



SaySql = "select * from TmpTablo" 'öðretmenler tablosundan öðretmen seç



    SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    KytSay = SayRS(0)

    Krt = " where [" & SayRS(0).Name & "] Is Not Null"

    SayRS.Close

    SayRS.Open SaySql & Krt, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    If SayRS.RecordCount = 0 Then

        DoCmd.DeleteObject acTable, "TmpTablo"

        MsgBox "Tabloda veri yok"

        Exit Sub

    End If

    SayRS.Close



'hy Excel Boþ Mu_____________Bitti







KytSy1 = DCount("*", "Tablo1")

CurrentDb.Execute " delete from tablo1 where [KOD] in (select [KOD] from TmpTablo)"



Dim kopyala

kopyala = Format(Now(), "dd_mm_yyyy_hh_mm_ss") & "_Tablo1"



DoCmd.CopyObject , kopyala, acTable, "Tablo1"



CurrentDb.Execute " delete from tablo1"



KytSy1Gncl = KytSy1 - DCount("*", "Tablo1")



CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _

                  " SELECT TmpTablo.KOD, TmpTablo.AD, TmpTablo.YAÞ, TmpTablo.Tarh " & _

                  " FROM TmpTablo where [KOD] Is Not Null"



CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _

                  " SELECT KOD, AD, yas, tarih " & _

                  " FROM " & kopyala & " where [KOD] Is Not Null"





KytSyEk = DCount("*", "Tablo1") - KytSy1



Me.Form2.Requery



    CurrentDb.TableDefs.Refresh

    DoCmd.DeleteObject acTable, "TmpTablo"

    DoCmd.DeleteObject acTable, kopyala



MsgBox "Transfer bitti" & Chr(10) & _

        "Güncellenen Kayýt Sayýsý : " & KytSy1Gncl & Chr(10) & _

        "Eklenen  Kayýt Sayýsý : " & KytSyEk & Chr(10) & _

        "Toplam Kayýt Sayýsý : " & DCount("*", "Tablo1")

End Sub

Beynimi yakacaksın bir gün
Anladığımı zannedip yapmaya çalışıyorum ama sana yetişemiyorum