Merhaba
Olayları biraz geriden takip ettiğimi düşünenleri olabilir ama bana yeten ve yaklaşık 15 senedir kullandığım access 2.0 da yazılmış bir proğrammım var gayette iyi çalışmakta ama artık yenilenmenin zamanı gelmiştir diyerek office 2003 kurdum ve proğramımı ona çevirdim çalışmayan bir çok yerini düzelttim ama takıldığım bir yer 15 günümü aldı. bana bu konuda yardımcı olabilirmisiniz.
istediğim Accessteki verilerimi excelle koşullu bir biçimde aktarmak. Kodlardanda anlayacağınız gibi sadece istenilen alanlar değişecek. Şimdiden teşekkürler.
Sub GoExcel()
Dim db As Database, dn As Dynaset
Set db = OpenDatabase("d:\kopi_ev\kopi\kopi.mdb")
Set dn = db.CreateDynaset("SELECT DISTINCTROW Makineler.KOD, Makineler.[Kuruluş tarihi], Min(Ziyaretler.Tarih) AS MinOfTarih, Min(Ziyaretler.Sayaç) AS MinOfSayaç, Max(Ziyaretler_1.Tarih) AS MaxOfTarih, Max(Ziyaretler.Sayaç) AS MaxOfSayaç, [MaxOfTarih]-[Kuruluş tarihi] AS Ömür, ([MaxOfSayaç]/[Ömür]) AS Günlük FROM (Ziyaretler INNER JOIN Makineler ON Ziyaretler.MAKİNE = Makineler.KOD) INNER JOIN Ziyaretler AS Ziyaretler_1 ON (Ziyaretler.Sayaç = Ziyaretler_1.Sayaç) AND (Ziyaretler.MAKİNE = Ziyaretler_1.MAKİNE) GROUP BY Makineler.KOD, Makineler.[Kuruluş tarihi] HAVING (((Max(Ziyaretler.Sayaç))>0 And (Max(Ziyaretler.Sayaç)) Is Not Null)) ORDER BY Makineler.KOD;")
C = DDEInitiate("Excel", "Sheet1") 'HEPSİ.XLS
MsgBox ("Veri okundu..Gönderim için OK")
t1 = Time
For t = 1 To 1000
tYer = "R" & t & "C1"
D = DDERequest(C, tYer)
D = Left(D, Len(D) - 2)
dn.MoveFirst
While Not dn.EOF
If Trim(D) = Trim(dn("KOD")) Then
Yer = "R" & t & "C6"
DDEPoke C, Yer, dn("MinOfTarih")
Yer = "R" & t & "C7"
DDEPoke C, Yer, dn("MinOfSayaç")
Yer = "R" & t & "C8"
DDEPoke C, Yer, dn("MaxOfTarih")
Yer = "R" & t & "C9"
DDEPoke C, Yer, dn("MaxOfSayaç")
End If
dn.MoveNext
Wend
Next
t2 = Time - t1
MsgBox ("BİTTİİ")
MsgBox ("Süre : " & t2)
End Sub
Olayları biraz geriden takip ettiğimi düşünenleri olabilir ama bana yeten ve yaklaşık 15 senedir kullandığım access 2.0 da yazılmış bir proğrammım var gayette iyi çalışmakta ama artık yenilenmenin zamanı gelmiştir diyerek office 2003 kurdum ve proğramımı ona çevirdim çalışmayan bir çok yerini düzelttim ama takıldığım bir yer 15 günümü aldı. bana bu konuda yardımcı olabilirmisiniz.
istediğim Accessteki verilerimi excelle koşullu bir biçimde aktarmak. Kodlardanda anlayacağınız gibi sadece istenilen alanlar değişecek. Şimdiden teşekkürler.
Sub GoExcel()
Dim db As Database, dn As Dynaset
Set db = OpenDatabase("d:\kopi_ev\kopi\kopi.mdb")
Set dn = db.CreateDynaset("SELECT DISTINCTROW Makineler.KOD, Makineler.[Kuruluş tarihi], Min(Ziyaretler.Tarih) AS MinOfTarih, Min(Ziyaretler.Sayaç) AS MinOfSayaç, Max(Ziyaretler_1.Tarih) AS MaxOfTarih, Max(Ziyaretler.Sayaç) AS MaxOfSayaç, [MaxOfTarih]-[Kuruluş tarihi] AS Ömür, ([MaxOfSayaç]/[Ömür]) AS Günlük FROM (Ziyaretler INNER JOIN Makineler ON Ziyaretler.MAKİNE = Makineler.KOD) INNER JOIN Ziyaretler AS Ziyaretler_1 ON (Ziyaretler.Sayaç = Ziyaretler_1.Sayaç) AND (Ziyaretler.MAKİNE = Ziyaretler_1.MAKİNE) GROUP BY Makineler.KOD, Makineler.[Kuruluş tarihi] HAVING (((Max(Ziyaretler.Sayaç))>0 And (Max(Ziyaretler.Sayaç)) Is Not Null)) ORDER BY Makineler.KOD;")
C = DDEInitiate("Excel", "Sheet1") 'HEPSİ.XLS
MsgBox ("Veri okundu..Gönderim için OK")
t1 = Time
For t = 1 To 1000
tYer = "R" & t & "C1"
D = DDERequest(C, tYer)
D = Left(D, Len(D) - 2)
dn.MoveFirst
While Not dn.EOF
If Trim(D) = Trim(dn("KOD")) Then
Yer = "R" & t & "C6"
DDEPoke C, Yer, dn("MinOfTarih")
Yer = "R" & t & "C7"
DDEPoke C, Yer, dn("MinOfSayaç")
Yer = "R" & t & "C8"
DDEPoke C, Yer, dn("MaxOfTarih")
Yer = "R" & t & "C9"
DDEPoke C, Yer, dn("MaxOfSayaç")
End If
dn.MoveNext
Wend
Next
t2 = Time - t1
MsgBox ("BİTTİİ")
MsgBox ("Süre : " & t2)
End Sub