AccessTr.neT

Tam Versiyon: Excelden Veri Alma Ve Kaydı Güncelleme
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
(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ı Img-grin
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



[Resim: ErfgCdeO.gif]
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 Img-grin



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
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19