Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 07/02/2020
(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?
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - berduş - 07/02/2020
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.
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 07/02/2020
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
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - berduş - 07/02/2020
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?
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 07/02/2020
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
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - accessman - 07/02/2020
Beynimi yakacaksın bir gün
Anladığımı zannedip yapmaya çalışıyorum ama sana yetişemiyorum
|