• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çalışma hakkında yardım

acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
Kolay gelsin arkadaşlar,

Bir çalışmamda sürekli kapalı dosyadan veri alıp işlem yapıyorum.
Fakat bazen aldığım verilerde değişiklik yapmam gerekiyor.

Bunun yerine kapalı dosyadaki verileri açılışta kapalı dosyadaki sayfa ismiyle aynı bir sayfaya alsam .(en az 5000 satır)
Sonrasında bu sayfa üzerinde arama-düzenleme yaptıktan sonra dosyayı kapatırken kapalı dosydaki aynı isimli sayfaya kopyalamak mı daha doğru olur?
 
ADO Connection ile kolayca yapabilirsin. Bir örnek ekle hazırlayalım
 
Kod: 
Private Sub Workbook_Open()
Application.ScreenUpdating = False
 Dim Con As Object, Rs As Object, Sorgu As String
 tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
        Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\MalzemeListesi.xls" & ";extended properties=""excel 12.0;hdr=no"""
        Sorgu = "Select * from [MalzemeListesi$] where f2 like '" & "" & "%'"
        Rs.Open Sorgu, Con, 1, 1
        ml.Range("A2").CopyFromRecordset Rs
        
        
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
End Sub

Buradaki kodlarla tüm verileri hızlı bir şekilde alıyorum.
Ve bu listeyi listboxa aktarabiliyorum.Textboxtdaki değere göre de süzme yapabiliyorum.
Fakat bu olay sürekli kapalı dosyadan veri çekmekle oluyor.
Onun yerine Dosya açılırken bir defa kapalı dosyadan tüm verileri alsam güncelleme silme -ekleme gibi işlemleri yapsam
Dosyamı kapatırken de yine aynı kapalı dosyaya kaydetsem diye düşündüm.

Hangi olay daha kolaylık sağlar?
 
Ben sizi anladım. Uygulamanız gayet güzel. Yapılacak bir iyileştirme yok.

Sizin sıkıntınız ordaki listeyi Workbook açılışında çekersem daha hızlı çalışan ve dinamik bir uygulama olcağını düşünüosunuz.

5200 satırda süzme bulma ekleme gibi işlemler excelin kapalı dosyada zor ve yavaş oluyor.

5200 listenizi Accese taşımanızı tavsiye ederim.

Formunuzda Düzenle butonu boş gözüküyor. Kaydın nasıl güncelleceğinide ekleyebilirim
 
Size zahmet kodlarla ilgili satır açıklama da yapabilirseniz benim için süper olur.
Bu konuya fazlasıyla merak saldım.
Bu kodllarda aynı calışma kitabında bile veri alınabiliyor :)
For next döngüsünden kat kat hızlı veri çekiyor.

Eğer açıklama ile yazarsanız ben de kendimi bu aşamada daha da geliştirebilirim inşallah...
 
Aslında bende Adoda yeni yeni keşfediyorum

Bence ilk önce malzeme listenizi accesse taşıyın
Çünkü çok hızlı verileri yönetiyorsunuz excele göre

Ado başlangıç için Connection Tanımlaması yapamanız gerekiyor.

Kod: 
Dim con As Object, rs As Object
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")


Sonra excele bağlanmak için sağlayıcı. Kırmızı yolu istediğiniz gibi değiştirin

Kod: 
Con.Open "provider=microsoft.ace.oledb.12.0;data source=[B][COLOR="Red"]" & _
        ThisWorkbook.Path & "\MalzemeListesi.xls"[/COLOR][/B] & ";extended properties=""excel 12.0;hdr=no"""

Accesse bağlanmak için

Kod: 
Const yol As String = [COLOR="Red"][B]"M:\MDATA.accdb"[/B][/COLOR]
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""

2 türlüde excel yada accesse bağlandık.

Şimdi hangi kayıtı kullancağımızı seçeceğiz

Select den sonraki * (yıldız) hepsi anlamnına gelir
from [MalzemeListesi$] hangi tablodan alçağımızı tanımlıyor( excelde sayfa ismi)

where f2 hangi sütuna bakacağımızı belirliyoruz. f2 değişken tanımlayabilirsin. textbox, range vs.

like , gibi anlamanına gelir. Eşitlik bakmaz like devamında arayacağımız değişkeni yazarız

Kod: 
Sorgu = "Select * from [MalzemeListesi$] where f2 like '" & "" & "%'"

yukarda sorguyu oluşturduk o sorguyu seçiyoruz kaç tane varsa

Kod: 
Rs.Open Sorgu, Con, 1, 1
        ml.Range("A2").CopyFromRecordset Rs

A2 den itibaren yapıştırırıyoruz

:) bu kadar

Not : Hüseyin Çoban , Orion ve kuvari arkadaşların yardımlarıyla öğrendim.Başlangıçtayım ama. Teşekkürler
 
Kod: 
Dim Con As Object, Rs As Object, Sorgu As String

    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""

        Sorgu = "Select * from MalzemeListesi where BarkodNumarasi like '" & "" & "%'"
        Rs.Open Sorgu, Con, 1, 1
        ml.Range("A2").CopyFromRecordset Rs
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""


Kodlar bu şekilde olunca düzeldi.
Artık access dosyasında veri alabiliyorum . Lakin Düzeltme silmeye de ihtiyacım vardır.
 
Son düzenleme:
Düzeltme update ile yapılıyor
Soru : nereyi düzelteceğim

A tablosunda B sütununda MEHMET olan kaydı güncellemek istiosun



Kod: 
Dim Con As Object, Rs As Object, Sorgu As String

    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""

        Sorgu = "Select * from [B]A[/B] where [B]B[/B] = '" & "[B]MEHMET[/B]" & "%'"
        Rs.Open Sorgu, Con, 1, 1
       [B] rs("C").Value = Worksheets("Data").Range("t13").Value [/B]
      [B]  rs.Update[/B]
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""

Güncellemek istediğin her sütun için yazacaksın
Kod: 
rs("C").Value = Worksheets("Data").Range("t13").Value
 
Kod: 
rs("C").Value = Worksheets("Data").Range("t13").Value

Bunun anlamı:
Access dosyasındaki Mehmet e eşit olan Satırdaki C Sütunundaki değeri değiştir midir?
 
acar6783' Alıntı:
Kod: 
rs("C").Value = Worksheets("Data").Range("t13").Value

Bunun anlamı:
Access dosyasındaki Mehmet e eşit olan Satırdaki C Sütunundaki değeri değiştir midir?
Genişletmek için tıkla ...

aynen :)
Kod: 
rs("C").Value = Worksheets("Data").Range("t13").Value
rs("D").Value = Worksheets("Data").Range("t13").Value
rs("E").Value = Worksheets("Data").Range("t13").Value

Coğaltabilirsin
 
Kod: 
Sub baglan()
Dim Con As Object, Rs As Object, Sorgu As String
tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""
deg1 = stok.s1.Value
deg2 = stok.s2.Value
deg3 = stok.s3.Value
deg4 = stok.s4.Value
deg5 = stok.s5.Value
deg6 = stok.s6.Value
deg7 = stok.s7.Value

 Sorgu = "SELECT Sıra,BarkodNumarasi,MalzemeHesabiAdi,Kategori,FiiliMiktar,AlışFiyatı,SatışFiyatı  FROM  MalzemeListesi WHERE Sıra LIKE '" & deg1 & "%' AND BarkodNumarasi LIKE '" & deg2 & "%' AND MalzemeHesabiAdi LIKE '" & deg3 & "%' AND Kategori LIKE '" & deg4 & "%' AND FiiliMiktar LIKE '" & deg5 & "%' AND AlışFiyatı LIKE '" & deg6 & "%' AND SatışFiyatı LIKE '" & deg7 & "%'"
        
        Rs.Open Sorgu, Con, 1, 3
        ml.Range("A2").CopyFromRecordset Rs
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""



End Sub

Kodları bu şekilde düzenledim. Ve bunu bir module atadım.Sonrasında her arama textboxını da kodu çalıştıracak şekilde düzenledim.
Sonuç süper oldu :)
Hangi textboxa veri girersem gireyim girdiğim verilere göre listboxa ver çekiyor.

Düzenleme işlemini de uyarlayacağım sonrasında bir tek kayıt silme kalıyor.
 
Kod: 
 Sorgu = "SELECT Sıra,BarkodNumarasi,MalzemeHesabiAdi,Kategori,FiiliMiktar,AlışFiyatı,SatışFiyatı  FROM  MalzemeListesi WHERE Sıra LIKE '" & deg1 & "%' AND BarkodNumarasi LIKE '" & deg2 & "%' AND MalzemeHesabiAdi LIKE '" & deg3 & "%' AND Kategori LIKE '" & deg4 & "%' AND FiiliMiktar LIKE '" & deg5 & "%' AND AlışFiyatı LIKE '" & deg6 & "%' AND SatışFiyatı LIKE '" & deg7 & "%'"

[B][COLOR="Red"]rs.delete[/COLOR][/B]

Rs yi seçip delete yapıosun
 
hlojan' Alıntı:
Kod: 
 Sorgu = "SELECT Sıra,BarkodNumarasi,MalzemeHesabiAdi,Kategori,FiiliMiktar,AlışFiyatı,SatışFiyatı  FROM  MalzemeListesi WHERE Sıra LIKE '" & deg1 & "%' AND BarkodNumarasi LIKE '" & deg2 & "%' AND MalzemeHesabiAdi LIKE '" & deg3 & "%' AND Kategori LIKE '" & deg4 & "%' AND FiiliMiktar LIKE '" & deg5 & "%' AND AlışFiyatı LIKE '" & deg6 & "%' AND SatışFiyatı LIKE '" & deg7 & "%'"

[B][COLOR="Red"]rs.delete[/COLOR][/B]

Rs yi seçip delete yapıosun
Genişletmek için tıkla ...

Ekteki hatayı veriyor
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    20.8 KB · Görüntüleme: 7
Kod: 
Rs.Open Sorgu, Con, 1, 3

yada

Kod: 
rs.Open sorgu, CurrentProject.Connection, adOpenDynamic, adLockOptimistic

Con, 1, 3, = CurrentProject.Connection, adOpenDynamic, adLockOptimistic
sayılar ayarları değiştiriyor
 
Kod: 
Rs.Open Sorgu, Con, 1, [COLOR="Red"]3[/COLOR]
Ben farklı bir dosyada 3 yerine 1 yazmıştım.
3 yapınca düzeldi..
 
Son düzenleme:
Kod: 
Sub baglan2()
Dim Con As Object, Rs As Object, Sorgu As String

    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""

 Sorgu = "SELECT BarkodNumarasi FROM  MalzemeListesi WHERE Sıra ='" & "6" & "%'"

        Rs.Open Sorgu, Con, 1, [COLOR="Red"]3[/COLOR]
      Rs("C").Value = Worksheets("Sayfa1").Range("F1").Value
        Rs.Update
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
End Sub

Burada da hata veriyor?
 

Ekli dosyalar

  • hata.jpg
    hata.jpg
    16.6 KB · Görüntüleme: 3
Kod: 
Rs.Open Sorgu, Con, 1, 3
      Rs("C").Value = Worksheets("Sayfa1").Range("F1").Value
        Rs.Update

update yapıosun con 1 1 dene
 
hlojan' Alıntı:
Kod: 
Rs.Open Sorgu, Con, 1, 3
      Rs("C").Value = Worksheets("Sayfa1").Range("F1").Value
        Rs.Update

update yapıosun con 1 1 dene
Genişletmek için tıkla ...

Denedim hatta farklı ihtimaller de denedim ama olmadı.
Silem tamam fakat düzenlemeyi yapamadık.
 
Tüm sorunlarımı çözdüm fakat bağlanma süresi excel dosyasına göre saki daha yavaş oldu.

Kod: 
Sub baglan()
Dim Con As Object, Rs As Object, Sorgu As String
tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""
deg1 = stok.s1.Value
deg2 = stok.s2.Value
deg3 = stok.s3.Value
deg4 = stok.s4.Value
deg5 = stok.s5.Value
deg6 = stok.s6.Value
deg7 = stok.s7.Value

 Sorgu = "SELECT Sıra,BarkodNumarasi,MalzemeHesabiAdi,Kategori,FiiliMiktar,AlışFiyatı,SatışFiyatı  " _
 & "FROM  MalzemeListesi WHERE Sıra LIKE '" & deg1 & "%' " _
 & "AND BarkodNumarasi LIKE '" & deg2 & "%' " _
 & "AND MalzemeHesabiAdi LIKE '" & deg3 & "%' " _
 & "AND Kategori LIKE '" & deg4 & "%' " _
 & "AND FiiliMiktar LIKE '" & deg5 & "%' " _
 & "AND AlışFiyatı LIKE '" & deg6 & "%' " _
 & "AND SatışFiyatı LIKE '" & deg7 & "%'"
        
        Rs.Open Sorgu, Con, 1, 3
        ml.Range("A2").CopyFromRecordset Rs
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
stok.stoklist.List = ml.Range("A2:G" & ml.Cells(Rows.Count, "B").End(3).Row + 1).Value

End Sub
Sub Guncelle()

Dim Con As Object, Rs As Object, Sorgu As String
tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""
Con.Execute "update " & "[MalzemeListesi]" & _
                " set BarkodNumarasi ='" & stok.BA.Value & "', MalzemeHesabiAdi ='" & stok.MA.Value & _
                "' where BarkodNumarasi='" & stok.stoklist.Column(1) & "' AND MalzemeHesabiAdi = '" & stok.stoklist.Column(2) & "'"

    Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
           
End Sub

Sub sil()
Dim Con As Object, Rs As Object, Sorgu As String
tanimlamalar
    Set Con = CreateObject("Adodb.Connection")
    Set Rs = CreateObject("Adodb.RecordSet")
    ml.Range("A2:H65536").ClearContents
Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\" & "MalzemeListesi.mdb" & ""

deg2 = stok.BA.Value

 Sorgu = "SELECT * " _
 & "FROM  MalzemeListesi WHERE BarkodNumarasi = '" & deg2 & "' "
        
        Rs.Open Sorgu, Con, 1, 3
       Rs.Delete
        Rs.Close: Con.Close
    Set Con = Nothing: Set Rs = Nothing: Sorgu = ""
stok.stoklist.List = ml.Range("A2:G" & ml.Cells(Rows.Count, "B").End(3).Row + 1).Value

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst