AccessTr.neT

Bul · 02/02/2020, 01:48

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.

Bul · 02/02/2020, 01:56

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.

Bul · 02/02/2020, 01:57

önemli değil, bir yerlerden öğrenmeye çalışırım)
iyi çalışmalar

Bul · 02/02/2020, 01:59

dictionary öğrenmek istiyorsanız kaynak çok.Yinede buraya sizin için bir örnek ekleyeyim ve açıklayayım anlamlarını

Bul · 02/02/2020, 02:09

zahmet olmasın?

Bul · 02/02/2020, 03:20

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 If

yukarıdaki kod dict in içine benzersiz veri alıyor bir kez içine.Eğer mükerrer veri olsaydı hata olurdu bu yüzden If Not scr.Exists(rs(0).Value) Then ile aynı veri yoksa koşulu eklendi.

scr(rs(0).Value) = scr(rs(0).Value)

bu kısımda aynısı if koşuluna gerek yok burda.Fakat item değil key e veriler gelir.

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.Count

Alttaki 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
'    Next

Alttakide normal döngü ile aynısı.

For i = 0 To scr.Count - 1 '0 dan baslar
      Debug.Print scr.Keys()(i)
    Next

Alttaki 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 toptan

Normalde 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

AccessTr.neT

Excelden Veri Alma Ve Kaydı Güncelleme

Excelden Veri Alma Ve Kaydı Güncelleme

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Giriş yap

Hesap oluştur

Konu Linkleri