• DİKKAT

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

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

K

konas06

Katılım
27 Kasım 2007
Mesajlar
664
Excel Vers. ve Dili
ofis 2016 Türkçe
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.
 

Ekli dosyalar

  • SUZ.rar
    SUZ.rar
    17.8 KB · Görüntüleme: 12
Dosyanız ektedir.:cool:
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
 

Ekli dosyalar

Evren Gizlen' Alıntı:
Dosyanız ektedir.:cool:
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
Genişletmek için tıkla ...
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.
 
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.:cool:
 
Merhaba,
eğer dosyalar farklı klasörde olursa bir örnek verebilir misiniz?
Örnek dosya ektedir.
Selamlar.
 

Ekli dosyalar

konas06' Alıntı:
Merhaba,
eğer dosyalar farklı klasörde olursa bir örnek verebilir misiniz?
Örnek dosya ektedir.
Selamlar.
Genişletmek için tıkla ...
Dosyanız ektedir.:cool:
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
 

Ekli dosyalar

İ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.
 
Son düzenleme:
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?
 
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.
 
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.
Genişletmek için tıkla ...

ZAMAN adlı dosyanın içinde o dediğiniz çalışma kitabını nasıl gösterecez?
Nerseini gösterecez.:cool:
 
Evren Gizlen' Alıntı:
Dosyanız ektedir.:cool:
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
Genişletmek için tıkla ...

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.
 
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.
Genişletmek için tıkla ...

ZAMAN adlı dosyanın hangi sayfasında göstereceğiz.(excel dosyası olduğunu kabul ediyorum)
 
Evren Gizlen' Alıntı:
ZAMAN adlı dosyanın hangi sayfasında göstereceğiz.(excel dosyası olduğunu kabul ediyorum)
Genişletmek için tıkla ...

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.
 
konas06' Alıntı:
Tekrar merhaba,
örnek "D sürücü " sünün altında "ZAMAN" adlı dosyanın içinde .
Genişletmek için tıkla ...

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. .
Genişletmek için tıkla ...


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.
Genişletmek için tıkla ...

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.:cool:
 
Evet Evren bey,
Aynı dosya sadece dosyanın yolu değişti.
Yardımlarınız bekliyorum.
Selamlar.
 
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.:cool:
Genişletmek için tıkla ...
İyi geceler.
Evren bey yardımlarınızı bekliyorum efendim.
Saygılar Selamlar.
 
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.
Genişletmek için tıkla ...

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\"
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst