Tarih kriterine göre ilgili satırlar aktarmak hk.

konas06 · 28 Temmuz 2010

Merhaba,
bir klasör içinde 2 çalışma kitabı var.
1. kitap çok fazla bilginin olduğu bir çalışma.
Bu sebeple 2. kitapta daha az bilgileri alarak üzerinde çalışmak gerekiyor bunun için 2. kitapta başlangıç ve bitiş tarih kriterlerini vererek 1. kitaptan bilgileri aktarmak istiyoruz.
Bunu sağlayabilir miyiz?
Saygılarımla.

Orion1 · 28 Temmuz 2010

Dosyanız ektedir.

Kod:

Sub veri_al_59()
'Tools referenceden microsoft library activex 2.x eklendi
Dim conn As Connection, rs As ADODB.Recordset, sat As Long
Dim yol As String, dosya As String
Sheets("ÇALIŞMA").Select
If Not IsDate(Range("B3").Value) Or Not IsDate(Range("C3").Value) Then
    MsgBox "Başlangış tarihi veya bitiş tarihi yanlış girilmiş" & vbLf & _
    "İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
yol = ThisWorkbook.Path & "\"
dosya = "TUM BILGILERIN OLDUGU DOSYA.xls"
If yol & dosya = "" Then
    MsgBox yol & dosya & " Bulunamadı." & vbLf & " İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & dosya _
& ";extended properties=""excel 8.0;hdr=yes;"""
rs.Open "select * from [ÖDEME$A1:I65536] where  TARİH >=" & CDbl(Range("B3").Value) _
& " and TARİH <=" & CDbl(Range("C3").Value) & " order by TARİH;", conn, adOpenKeyset, adLockReadOnly
sat = Cells(65536, "A").End(xlUp).Row + 1
If rs.RecordCount + sat >= 65533 Then
    MsgBox "Alınan veriler çok fazla sayfaya sığmıyor." & vbLf & "İşlem iptal edildi.", vbCritical, "UYARI"
    GoTo atla
End If
Application.ScreenUpdating = False
Range("A9:I65536").ClearContents
Range("A9").CopyFromRecordset rs
Application.ScreenUpdating = True
atla:
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

konas06 · 28 Temmuz 2010

Çok teşekkür ederim.
Selamlar.

konas06 · 28 Temmuz 2010

Evren Gizlen' Alıntı:

Dosyanız ektedir.

Kod:

Sub veri_al_59()
'Tools referenceden microsoft library activex 2.x eklendi
Dim conn As Connection, rs As ADODB.Recordset, sat As Long
Dim yol As String, dosya As String
Sheets("ÇALIŞMA").Select
If Not IsDate(Range("B3").Value) Or Not IsDate(Range("C3").Value) Then
    MsgBox "Başlangış tarihi veya bitiş tarihi yanlış girilmiş" & vbLf & _
    "İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
yol = ThisWorkbook.Path & "\"
dosya = "TUM BILGILERIN OLDUGU DOSYA.xls"
If yol & dosya = "" Then
    MsgBox yol & dosya & " Bulunamadı." & vbLf & " İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & dosya _
& ";extended properties=""excel 8.0;hdr=yes;"""
rs.Open "select * from [ÖDEME$A1:I65536] where  TARİH >=" & CDbl(Range("B3").Value) _
& " and TARİH <=" & CDbl(Range("C3").Value) & " order by TARİH;", conn, adOpenKeyset, adLockReadOnly
sat = Cells(65536, "A").End(xlUp).Row + 1
If rs.RecordCount + sat >= 65533 Then
    MsgBox "Alınan veriler çok fazla sayfaya sığmıyor." & vbLf & "İşlem iptal edildi.", vbCritical, "UYARI"
    GoTo atla
End If
Application.ScreenUpdating = False
Range("A9:I65536").ClearContents
Range("A9").CopyFromRecordset rs
Application.ScreenUpdating = True
atla:
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Evren bey çok teşekkürler.
Bu konu ile ilgili sizden bir ricam daha olabilir mi?
Bu işlemi başka iki dosyalara uygulayacağımdan dolayı, çok kısa bir şekilde birer cümle ile değişiklik yapılacak yerlere notlar yazabilir misiniz?
Şimdiden çok teşekkürler.

Orion1 · 28 Temmuz 2010

Başka bir dosyada yapacaksanız aşağıdaki durumlara dikkat etmelisiniz.
1-Tools referenceden microsoft library activex 2.x eklendi
2 -Asıl dosyanızda ÇALIŞMA isminde sayfanızın olması lazım.
3-ÇALIŞMA SAYFASINDA B3 hücresine ve C3 hücresinde Tarih olmalı
zaten yoksa ikaz veri işlem iptal oluyor.
4-yol = ThisWorkbook.Path & "\" buradaki yol verilerin alınacağı dosyanın bulunduğu klasör.Burada ben her 2 dosyanında ayni klasör içinde olduğunu kabul eettim.Siz isterseniz yol klasörünü verileri alacağınız dosyanın bulunduğu klasöre göre yazarsınız.
5-dosya = "TUM BILGILERIN OLDUGU DOSYA.xls"
dosya değişkenine verilerin alınacağı dosyanın adı yazılıdır
6-Tarihlerin olduğu sütunun başlığının adı TARİH olmalı.Diğer sütun başlıklarındada içinde boşluk olamamlı,veya nokta olamamlı Birleştirilmiş hücre olamalı.
6-rs.Open "select * from [ÖDEME$A1:I65536] where TARİH >=" & CDbl(Range("B3").Value) _
& " and TARİH <=" & CDbl(Range("C3").Value) & " order by TARİH;", conn, adOpenKeyset, adLockReadOnly
Verileri alacağınız dosyada ÖDEME isimli sat-yfa var.Ve veriler o sayfadan alınıyor.A1:I65536 aralığındaki veriler alınıyor.Tabii tarih sorgulayarak.Ve alınan veriler tarih sıarasına göre yerleştiriliyor.
İşlem bu kadardır.
önemli not:
Veri alınan dosyada 1 sütununda bir takım veriler sayı veya tarih ise ve bir takım veriler string ve metin ise bunların çokluğuna göre birisini (yani stringi veya sayıyı) listeye alıyor,diğerlerini listeye almıyor.
Bu yüzden bir sütuna hep ayni değişken tiplerini girmelisiniz.yani sürunun yarısına sayı yarısına metin girmemelisiniz.Eğer o sütun sayı ise hep sayı girilmeli.metinse hep metin girimeli.Bu şart verilerin alındığı dosya içindir.
ADO excele benzemez.Beynelmileldir.Ve katı kuralları vardır.
Zaten öylede olması lazım.Bazı kuralları olmasa her şey birbirine karışır.Ve yapılan iş süresi uzar.
Bu kadar.Kolay gelsin.

konas06 · 29 Temmuz 2010

Çok teşekkür ederim. ellerinize sağlık

Orion1 · 29 Temmuz 2010

konas06' Alıntı:
Çok teşekkür ederim. ellerinize sağlık

Rica ederim.
İyi çalışmalar.

konas06 · 29 Temmuz 2010

Merhaba,
eğer dosyalar farklı klasörde olursa bir örnek verebilir misiniz?
Örnek dosya ektedir.
Selamlar.

Orion1 · 30 Temmuz 2010

konas06' Alıntı:
Merhaba,
eğer dosyalar farklı klasörde olursa bir örnek verebilir misiniz?
Örnek dosya ektedir.
Selamlar.

Dosyanız ektedir.

Kod:

Sub veri_al_59()
'Tools referenceden microsoft library activex 2.x eklendi
Dim conn As Connection, rs As ADODB.Recordset, sat As Long
Dim yol As String, dosya As String
Dim ds, f

Sheets("ÇALIŞMA").Select
If Not IsDate(Range("B3").Value) Or Not IsDate(Range("C3").Value) Then
    MsgBox "Başlangış tarihi veya bitiş tarihi yanlış girilmiş" & vbLf & _
    "İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
Set ds = CreateObject("Scripting.FileSystemObject")

[B][COLOR="Blue"]yol = ds.GetParentFolderName(ThisWorkbook.Path) & "\A KLASORU\"[/COLOR][/B]
dosya = "TUM BILGILERIN OLDUGU DOSYA.xls"
If yol & dosya = "" Then
    MsgBox yol & dosya & " Bulunamadı." & vbLf & " İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & dosya _
& ";extended properties=""excel 8.0;hdr=yes;"""
rs.Open "select * from [ÖDEME$A1:I65536] where  TARİH >=" & CDbl(Range("B3").Value) _
& " and TARİH <=" & CDbl(Range("C3").Value) & " order by TARİH;", conn, adOpenKeyset, adLockReadOnly
sat = Cells(65536, "A").End(xlUp).Row + 1
If rs.RecordCount + sat >= 65533 Then
    MsgBox "Alınan veriler çok fazla sayfaya sığmıyor." & vbLf & "İşlem iptal edildi.", vbCritical, "UYARI"
    GoTo atla
End If
Application.ScreenUpdating = False
Range("A9:I65536").ClearContents
Range("A9").CopyFromRecordset rs
Application.ScreenUpdating = True
atla:
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

konas06 · 30 Temmuz 2010

İlginiz için teşekkür ederim.
Farklı sürücülerde bu işlemi yaptığımda yada ağda kullanılan bir klasör olursa aynı şekilde işlem yapabilir miyim?
Selamlar.

konas06 · 1 Ağustos 2010

Farklı sürücülerde bu işlemi yaptığımda yada ağda kullanılan bir klasör olursa aynı şekilde işlem yapabilir miyim?

konas06 · 3 Ağustos 2010

Tekrar merhaba,
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde "TUM BILGILERIN OLDUGU DOSYA" adlı bir çalışma kitabını nasıl göstermemiz gerekiyor.
İlgilenen herkese teşekkür ederim.

Orion1 · 3 Ağustos 2010

konas06' Alıntı:
Tekrar merhaba,
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde "TUM BILGILERIN OLDUGU DOSYA" adlı bir çalışma kitabını nasıl göstermemiz gerekiyor.
İlgilenen herkese teşekkür ederim.

ZAMAN adlı dosyanın içinde o dediğiniz çalışma kitabını nasıl gösterecez?
Nerseini gösterecez.

konas06 · 4 Ağustos 2010

Evren Gizlen' Alıntı:

Dosyanız ektedir.

Kod:

Sub veri_al_59()
'Tools referenceden microsoft library activex 2.x eklendi
Dim conn As Connection, rs As ADODB.Recordset, sat As Long
Dim yol As String, dosya As String
Sheets("ÇALIŞMA").Select
If Not IsDate(Range("B3").Value) Or Not IsDate(Range("C3").Value) Then
    MsgBox "Başlangış tarihi veya bitiş tarihi yanlış girilmiş" & vbLf & _
    "İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
yol = ThisWorkbook.Path & "\"
dosya = "TUM BILGILERIN OLDUGU DOSYA.xls"
If yol & dosya = "" Then
    MsgBox yol & dosya & " Bulunamadı." & vbLf & " İşlem iptal edildi.", vbCritical, "UYARI"
    Exit Sub
End If
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & dosya _
& ";extended properties=""excel 8.0;hdr=yes;"""
rs.Open "select * from [ÖDEME$A1:I65536] where  TARİH >=" & CDbl(Range("B3").Value) _
& " and TARİH <=" & CDbl(Range("C3").Value) & " order by TARİH;", conn, adOpenKeyset, adLockReadOnly
sat = Cells(65536, "A").End(xlUp).Row + 1
If rs.RecordCount + sat >= 65533 Then
    MsgBox "Alınan veriler çok fazla sayfaya sığmıyor." & vbLf & "İşlem iptal edildi.", vbCritical, "UYARI"
    GoTo atla
End If
Application.ScreenUpdating = False
Range("A9:I65536").ClearContents
Range("A9").CopyFromRecordset rs
Application.ScreenUpdating = True
atla:
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler Aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Evren Bey, bu mesajda yapılan çalışma vardı ya bu aynı klasör içindeki iki dosyanın birbirinden veri çekmesi idi konu. Ancak bilgi alınan dosya başka klasörde olması gerekiyor, onun için şu şekilde bir örnek veriyorum. Bunu nasıl gösterebiliriz diye danışıyorum.
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde "TUM BILGILERIN OLDUGU DOSYA" adlı bir çalışma kitabını nasıl göstermemiz gerekiyor.
Selamlar.

Orion1 · 4 Ağustos 2010

konas06' Alıntı:
Evren Bey, bu mesajda yapılan çalışma vardı ya bu aynı klasör içindeki iki dosyanın birbirinden veri çekmesi idi konu. Ancak bilgi alınan dosya başka klasörde olması gerekiyor, onun için şu şekilde bir örnek veriyorum. Bunu nasıl gösterebiliriz diye danışıyorum.
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde "TUM BILGILERIN OLDUGU DOSYA" adlı bir çalışma kitabını nasıl göstermemiz gerekiyor.
Selamlar.

ZAMAN adlı dosyanın hangi sayfasında göstereceğiz.(excel dosyası olduğunu kabul ediyorum)

konas06 · 4 Ağustos 2010

Evren Gizlen' Alıntı:
ZAMAN adlı dosyanın hangi sayfasında göstereceğiz.(excel dosyası olduğunu kabul ediyorum)

Merhaba,
Dosya adresi şöyle
"D" Sürücüsünde "ZAMAN" adlı klasörün altında "TUM BILGILERIN OLDUGU DOSYA" dosya da "ÖDEME" adlı sayfadan bilgiler çekilecektir.

Not olarak da şu bilgiyi iletmem gerekiyor. Bu daha önceki mesajlardan farklı bir dosya değil. Aynı dosya aynı bilgiler alınacak ancak bilgilerin alındığı dosya yolu değişti.

Yardımlarınız bekliyorum.
Selamlar.

Orion1 · 4 Ağustos 2010

konas06' Alıntı:
Tekrar merhaba,
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde .

konas06' Alıntı:
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde "TUM BILGILERIN OLDUGU DOSYA" adlı bir çalışma kitabını nasıl göstermemiz gerekiyor. .

konas06' Alıntı:
Merhaba,
Dosya adresi şöyle
"D" Sürücüsünde ""ZAMAN" adlı klasörün altında "TUM BILGILERIN OLDUGU DOSYA" dosya da "ÖDEME" adlı sayfadan bilgiler çekilecektir.

Not olarak da şu bilgiyi iletmem gerekiyor. Bu daha önceki mesajlardan farklı bir dosya değil. Aynı dosya aynı bilgiler alınacak ancak bilgilerin alındığı dosya yolu değişti.

Yardımlarınız bekliyorum.
Selamlar.

Haaa bak şimdi oldu.
Yukarıdaki kırmızı renkli yazıda daha önce söylediğiniz konular ile bu son söylediğiniz farklı şeyler.Siz üst üste yukarıdaki ifadenizde ısrar edince bende konuyu tam anlayamadım.Devamlı sorular sordum.

konas06 · 5 Ağustos 2010

Evet Evren bey,
Aynı dosya sadece dosyanın yolu değişti.
Yardımlarınız bekliyorum.
Selamlar.

konas06 · 7 Ağustos 2010

Evren Gizlen' Alıntı:
Haaa bak şimdi oldu.
Yukarıdaki kırmızı renkli yazıda daha önce söylediğiniz konular ile bu son söylediğiniz farklı şeyler.Siz üst üste yukarıdaki ifadenizde ısrar edince bende konuyu tam anlayamadım.Devamlı sorular sordum.

İyi geceler.
Evren bey yardımlarınızı bekliyorum efendim.
Saygılar Selamlar.

Orion1 · 7 Ağustos 2010

konas06' Alıntı:
Merhaba,
Dosya adresi şöyle
"D" Sürücüsünde "ZAMAN" adlı klasörün altında "TUM BILGILERIN OLDUGU DOSYA" dosya da "ÖDEME" adlı sayfadan bilgiler çekilecektir.

Not olarak da şu bilgiyi iletmem gerekiyor. Bu daha önceki mesajlardan farklı bir dosya değil. Aynı dosya aynı bilgiler alınacak ancak bilgilerin alındığı dosya yolu değişti.

Yardımlarınız bekliyorum.
Selamlar.

Bu gayet basit.Böyle bir durum olacağını öngördüm ve ben bir tane yol ve bir tanede dosya isminde 2 string değişken tanımladım.
Yapacağınız sadece bu yol adlı string değişkene yeni yolu girmek olacaktı.
Aşağıdaki gibi.

Kod:

yol = "D:\ZAMAN\"

Tarih kriterine göre ilgili satırlar aktarmak hk.

konas06

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

konas06

konas06

Orion1

Uzman

konas06

Orion1

Uzman

konas06

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

konas06

konas06

konas06

Orion1

Uzman

konas06

Orion1

Uzman

konas06

Orion1

Uzman

konas06

konas06

Orion1

Uzman