+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Excelden Veri Alma Ve Kaydı Güncelleme (/konu-excelden-veri-alma-ve-kaydi-guncelleme.html)
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - berduş - 02/02/2020
kafa karışıklığı olmazdı bence, tam aksine farklı bir yolun olabileceğini de gösterdiği için daha yararlı olurdu. script yöntemi ve recordset yöntemi diye belirtmeniz yeterliydi.
Not: maalesef özelden dosya paylaşımı olmuyor ama isterseniz yine de dosya bağlantısını paylaşabilirseniz sevinirim.
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 02/02/2020
Abey dosyaları tüm silmişim.
Kapalı exceli açtırma olayına gıcık oluyorum görev yöneticisinden gitmediği için.
Aynı şekilde hazırlar eklerim unutmazsam yada indirenlerde eklerse iyi olur.
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - berduş - 02/02/2020
önemli değil, bir yerlerden öğrenmeye çalışırım)
iyi çalışmalar
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 02/02/2020
dictionary öğrenmek istiyorsanız kaynak çok.Yinede buraya sizin için bir örnek ekleyeyim ve açıklayayım anlamlarını
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - berduş - 02/02/2020
zahmet olmasın?
Cvp: Excelden Veri Alma Ve Kaydı Güncelleme - feraz - 02/02/2020
Bir örnek dosya ekledim açıklamalar var kodda yinede açıklayayım.
Bu dosyanın konu ile alakası yok sadece örnek.
Eğer dosyanın ilk açılışında hata gelirde dict ile alakası yok çalışıyor.
Mantık şu.
Veriler kapalı excelden geliyor.
If Not scr.Exists(rs(0).Value) Then ' Eger dictionary icinde rs(0).Value bu deger yoksa
say = say + 1
scr.Add rs(0).Value, say 'Burda say demek item i,rs(0).Value ise key dir
End Ifscr(rs(0).Value) = scr(rs(0).Value)yukarıdaki koddaki scr.Add rs(0).Value, say burda say item dir.
scr(rs(0).Value) = scr(rs(0).Value) ile scr.Add rs(0).Value , "" aynıdır aslında
alttaki kodlar ise join ile topluca mesaj kutusunda listeleniyor.
MsgBox "Dictionary keyler:" & vbNewLine & Join(scr.Keys, vbNewLine)
MsgBox "Dictionary itemler:" & vbNewLine & Join(scr.Items, vbNewLine)
MsgBox "Dictionary satir sayisi:" & vbNewLine & scr.CountAlttaki ise kezlerin içinde döngü kurdum immediate window ile sonucu incelersiniz yada additem ile combo yada listboxa çekersiniz.
' For Each xx In scr.Keys'Alttaki ile ayni
' Debug.Print xx
' NextFor i = 0 To scr.Count - 1 '0 dan baslar
Debug.Print scr.Keys()(i)
NextAlttaki ilede listboxa toplu veri aktarma.
Me.lstbox1.RowSource = ""
Me.lstbox1.RowSource = Join(scr.Keys, ";") 'Listboxa veri aliniyor toptan
Me.lstbox2.RowSource = ""
Me.lstbox2.RowSource = Join(scr.Items, ";") 'Listboxa veri aliniyor toptanNormalde excelde topluca hücrelere veri aktarma mesela range("A1").resize(scr.count,1).value=application.transpose(scr.keys) ile aktarılıyor belki yanlış yazmış olabilirim kafadan yazdım.Access te transpose göremedim.
Kodları F8 ile adım adım inceleyebilirsiniz watch vindow ilede takip edebilirsiniz.Özetle böyle.
Excledeki B sütunundaki verilerin benzersiz listelendiğini söyleyeyim.
Kodların tamamı.
Option Compare Database
Private Sub Komut0_Click()
Dim say As Long, say1 As Long
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSql As String
Dim txtDosyaAdres As String
Dim scr As Object
Set scr = CreateObject("Scripting.Dictionary")
txtDosyaAdres = CurrentProject.Path & "\veri.xlsx"
sSql = "select [KOD],[AD],[YAÞ] from [Sayfa1$B3:E] where [KOD] Is Not Null" '
Set con = New ADODB.Connection
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtDosyaAdres & ";extended properties=""excel 12.0;hdr=Yes;imex=1"""
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenKeyset
rs.LockType = adLockOptimistic
rs.Open sSql, con
Do While Not rs.EOF And Not rs.BOF 'Tablo güncelleme icin(Exceldeki recordseti icine alinan veriler icin döngü)
'--------------------------------------------------------------------------------------------------------------------------------
If Not scr.Exists(rs(0).Value) Then ' Eger dictionary icinde rs(0).Value bu deger yoksa
say = say + 1
scr.Add rs(0).Value, say 'Burda say demek item i,rs(0).Value ise key dir
End If
'Üst ve alt ayni
' scr(rs(0).Value) = scr(rs(0).Value) 'Burasi benzersiz veri alir.Bazen .value eklenmezse hata verir o yüzden .value eklendi
'--------------------------------------------------------------------------------------------------------------------------------
rs.MoveNext
Loop
MsgBox "Dictionary keyler:" & vbNewLine & Join(scr.Keys, vbNewLine)
MsgBox "Dictionary itemler:" & vbNewLine & Join(scr.Items, vbNewLine)
MsgBox "Dictionary satir sayisi:" & vbNewLine & scr.Count
'///////////////////////////////////////////////////////////////////
' For Each xx In scr.Keys'Alttaki ile ayni
' Debug.Print xx
' Next
For i = 0 To scr.Count - 1 '0 dan baslar
Debug.Print scr.Keys()(i)
Next
'///////////////////////////////////////////////////////////////////
Me.lstbox1.RowSource = ""
Me.lstbox1.RowSource = Join(scr.Keys, ";") 'Listboxa veri aliniyor toptan
Me.lstbox2.RowSource = ""
Me.lstbox2.RowSource = Join(scr.Items, ";") 'Listboxa veri aliniyor toptan
rs.Close
con.Close
Set rs = Nothing
Set scr = Nothing
End Sub