İki Tarih Arası Veri Getirme

ZorBey_ · 23 Temmuz 2013

Merhaba
İyi Çalışmalar
İki Tarih Arasında İstenen
Verileri Getirmek İstiyorum.

Mevcut Olan Kodlar
Seçilen Bir Tarihte
Diğer Sayfalardan
Verileri Getiriyor

Yapmak İstediğim
İlk Ve Son Tarih Yazıldığında
Seçilen Ürüne Göre Verileri
Diğer Sayfalardan Getirmesi
Teşekkür Ederim
İyi Çalışmalar.

halit3 · 23 Temmuz 2013

asr35' Alıntı:
Merhaba
İyi Çalışmalar
İki Tarih Arasında İstenen
Verileri Getirmek İstiyorum.

Mevcut Olan Kodlar
Seçilen Bir Tarihte
Diğer Sayfalardan
Verileri Getiriyor

Yapmak İstediğim
İlk Ve Son Tarih Yazıldığında
Seçilen Ürüne Göre Verileri
Diğer Sayfalardan Getirmesi
Teşekkür Ederim
İyi Çalışmalar.

KOD:

Kod:

Private Sub CommandButton1_Click()
Dim wsRap As Worksheet, ws As Worksheet
Dim i As Long, ss As Long

[COLOR="red"]Dim baslangıc, bitis, aranan1, deg1, deg2, yer1, yer2
baslangıc = Sheets("Rapor").Cells(2, "e").Value
bitis = Sheets("Rapor").Cells(3, "e").Value
aranan1 = Sheets("Rapor").Cells(3, "g").Value

If IsDate(baslangıc) <> True Then Exit Sub
If IsDate(bitis) <> True Then Exit Sub

deg1 = CDate(baslangıc)
deg2 = CDate(bitis)

If deg1 <= deg2 Then
yer1 = CDate(baslangıc)
yer2 = CDate(bitis)
Else
yer2 = CDate(baslangıc)
yer1 = CDate(bitis)
End If[/COLOR]


Set wsRap = Worksheets("Rapor")
wsRap.Range("A5:U500").ClearContents


For Each ws In Worksheets
With ws
If .Name <> "Rapor" And .Name <> "Ara" Then
For i = 5 To .Cells(.Rows.Count, "B").End(xlUp).Row

[COLOR="Red"]bulunan1 = .Cells(i, "f").Value

If CDate(yer1) <= CDate(.Cells(i, "D").Value) _
And CDate(yer2) >= CDate(.Cells(i, "D").Value) _
And bulunan1 = aranan1 Then[/COLOR]


ss = wsRap.Cells(Rows.Count, "B").End(xlUp).Row + 1
wsRap.Cells(ss, "A").Value = Application.Max(wsRap.Columns(1)) + 1
wsRap.Cells(ss, "B").Value = .Name
wsRap.Cells(ss, "C").Value = .Cells(i, "B").Value
wsRap.Cells(ss, "D").Value = .Cells(i, "C").Value
wsRap.Cells(ss, "E").Value = .Cells(i, "D").Value
wsRap.Cells(ss, "F").Value = .Cells(i, "E").Value
wsRap.Cells(ss, "G").Value = .Cells(i, "F").Value
wsRap.Cells(ss, "H").Value = .Cells(i, "G").Value
wsRap.Cells(ss, "I").Value = .Cells(i, "H").Value
wsRap.Cells(ss, "J").Value = .Cells(i, "I").Value
wsRap.Cells(ss, "K").Value = .Cells(i, "J").Value
wsRap.Cells(ss, "L").Value = .Cells(i, "K").Value
wsRap.Cells(ss, "M").Value = .Cells(i, "L").Value
wsRap.Cells(ss, "N").Value = .Cells(i, "M").Value
wsRap.Cells(ss, "O").Value = .Cells(i, "N").Value
wsRap.Cells(ss, "P").Value = .Cells(i, "O").Value
wsRap.Cells(ss, "Q").Value = .Cells(i, "P").Value
wsRap.Cells(ss, "R").Value = .Cells(i, "Q").Value
wsRap.Cells(ss, "S").Value = .Cells(i, "R").Value
wsRap.Cells(ss, "T").Value = .Cells(i, "S").Value
wsRap.Cells(ss, "U").Value = .Cells(i, "T").Value
wsRap.Cells(ss, "V").Value = .Cells(i, "U").Value
End If


Next
End If
End With
Next


Range("A1").Select
End Sub

İnşallah olmuştur.

ZorBey_ · 23 Temmuz 2013

Merhaba
Sayın
halit3 İyi Çalışmalar
Tam İstediğim Gibi
Çok Teşekkür Ederim Sağolun
Allah Razı Olsun.

halit3 · 23 Temmuz 2013

asr35' Alıntı:
Merhaba
Sayın
halit3 İyi Çalışmalar
Tam İstediğim Gibi
Çok Teşekkür Ederim Sağolun
Allah Razı Olsun.

Hayırlı akşamlar
İyi çalışmalar

drykcktl · 24 Eylül 2013

halit3' Alıntı:

KOD:

Kod:

Private Sub CommandButton1_Click()
Dim wsRap As Worksheet, ws As Worksheet
Dim i As Long, ss As Long

[COLOR="red"]Dim baslangıc, bitis, aranan1, deg1, deg2, yer1, yer2
baslangıc = Sheets("Rapor").Cells(2, "e").Value
bitis = Sheets("Rapor").Cells(3, "e").Value
aranan1 = Sheets("Rapor").Cells(3, "g").Value

If IsDate(baslangıc) <> True Then Exit Sub
If IsDate(bitis) <> True Then Exit Sub

deg1 = CDate(baslangıc)
deg2 = CDate(bitis)

If deg1 <= deg2 Then
yer1 = CDate(baslangıc)
yer2 = CDate(bitis)
Else
yer2 = CDate(baslangıc)
yer1 = CDate(bitis)
End If[/COLOR]


Set wsRap = Worksheets("Rapor")
wsRap.Range("A5:U500").ClearContents


For Each ws In Worksheets
With ws
If .Name <> "Rapor" And .Name <> "Ara" Then
For i = 5 To .Cells(.Rows.Count, "B").End(xlUp).Row

[COLOR="Red"]bulunan1 = .Cells(i, "f").Value

If CDate(yer1) <= CDate(.Cells(i, "D").Value) _
And CDate(yer2) >= CDate(.Cells(i, "D").Value) _
And bulunan1 = aranan1 Then[/COLOR]


ss = wsRap.Cells(Rows.Count, "B").End(xlUp).Row + 1
wsRap.Cells(ss, "A").Value = Application.Max(wsRap.Columns(1)) + 1
wsRap.Cells(ss, "B").Value = .Name
wsRap.Cells(ss, "C").Value = .Cells(i, "B").Value
wsRap.Cells(ss, "D").Value = .Cells(i, "C").Value
wsRap.Cells(ss, "E").Value = .Cells(i, "D").Value
wsRap.Cells(ss, "F").Value = .Cells(i, "E").Value
wsRap.Cells(ss, "G").Value = .Cells(i, "F").Value
wsRap.Cells(ss, "H").Value = .Cells(i, "G").Value
wsRap.Cells(ss, "I").Value = .Cells(i, "H").Value
wsRap.Cells(ss, "J").Value = .Cells(i, "I").Value
wsRap.Cells(ss, "K").Value = .Cells(i, "J").Value
wsRap.Cells(ss, "L").Value = .Cells(i, "K").Value
wsRap.Cells(ss, "M").Value = .Cells(i, "L").Value
wsRap.Cells(ss, "N").Value = .Cells(i, "M").Value
wsRap.Cells(ss, "O").Value = .Cells(i, "N").Value
wsRap.Cells(ss, "P").Value = .Cells(i, "O").Value
wsRap.Cells(ss, "Q").Value = .Cells(i, "P").Value
wsRap.Cells(ss, "R").Value = .Cells(i, "Q").Value
wsRap.Cells(ss, "S").Value = .Cells(i, "R").Value
wsRap.Cells(ss, "T").Value = .Cells(i, "S").Value
wsRap.Cells(ss, "U").Value = .Cells(i, "T").Value
wsRap.Cells(ss, "V").Value = .Cells(i, "U").Value
End If


Next
End If
End With
Next


Range("A1").Select
End Sub

İnşallah olmuştur.

Halit Bey yukarıdaki dosya üzerinde bazı değişiklikler yaptım ancak ekteki gibi hata alıyorum yardımcı olurmusunuz

ZorBey_ · 24 Eylül 2013

Merhaba İyi Çalışmalar
Sayın halit3'ün
Kodları Düzgün Çalışıyor
Sizin Sayfalarda Bazı Düzeltmeler Yaptım
Ekli Dosyayı İncelermisiniz.

drykcktl · 24 Eylül 2013

teşekkürler asr35 elinize sağlık kodlarda sorun yoktu zaten ama ben değişiklik yaparken biyerlerde hata yaptım

çok sağolun

ZorBey_ · 24 Eylül 2013

İyi Çalışmalar

drykcktl · 24 Eylül 2013

asr35' Alıntı:
İyi Çalışmalar

yine hata veriyor nerde yanlıştık yapıyorum acaba

drykcktl · 24 Eylül 2013

asr35' Alıntı:
İyi Çalışmalar

yine hata veriyor..nerde yanlış yapıyorum acaba

ZorBey_ · 24 Eylül 2013

Merhaba İyi Çalışmalar
Sayın drykcktl
Gönderdiğiniz Dosya Boş.

drykcktl · 25 Eylül 2013

asr35' Alıntı:
Merhaba İyi Çalışmalar
Sayın drykcktl
Gönderdiğiniz Dosya Boş.

kusura bakmayın son hali bu nerde hata yapıyorum acaba

nane · 25 Eylül 2013

Merhaba,
R ile S sütunu arasına 3 sütun eklediğimizde kodda ne gibi değişiklik yapmak gerekiyor ?
Teşekkürler
Yb®

ZorBey_ · 26 Eylül 2013

Merhaba İyi Çalışmalar
Sayın
drykcktl
Dosyanız 17.156 Kb
27.390 Satır
Örnek Dosyaları Bu Kadar
Yoğun Göndermenize Gerek Yok
Aslına Uygun Küçük Bir Örnek İş Görür
Dosyanızı Açarken Bayağı Bekleme Oldu
Gerekli Açıklamarı Dosya İçerisinde
Sayfa5'te Yaptım.

drykcktl · 26 Eylül 2013

asr35' Alıntı:
Merhaba İyi Çalışmalar
Sayın
drykcktl
Dosyanız 17.156 Kb
27.390 Satır
Örnek Dosyaları Bu Kadar
Yoğun Göndermenize Gerek Yok
Aslına Uygun Küçük Bir Örnek İş Görür
Dosyanızı Açarken Bayağı Bekleme Oldu
Gerekli Açıklamarı Dosya İçerisinde
Sayfa5'te Yaptım.

çok tşklr sayın Asr35 dosyaları o şekilde yollama sebebim ben işliyorum ve bir anda hata veriyor hangi noktada sıkıntı olduğunuda çözemiyorum..elinize sağlık ayrıca

ZorBey_ · 26 Eylül 2013

İyi Çalışmalar.

drykcktl · 26 Eylül 2013

teşekkürler sizede

drykcktl · 26 Eylül 2013

asr35' Alıntı:
İyi Çalışmalar.

sayın ASR35 biliyorum çok oluyorum ama
son bir ricam olacak sizden
dosyada açıklamaları ekledim
yardımcı olurmusunuz rica etsem

ZorBey_ · 26 Eylül 2013

Merhaba İyi Çalışmalar
Sayın drykcktl
Şu Andaki Konu Başlığı
İki Tarih Arasında Veri Getirme
Son Dosyanızadaki Konuya Göre
Yeni Bir Konu Açıp Dosyanızı Eklemelisiniz.
Bir arkadaşımız Yardımcı Olur.

İki Tarih Arası Veri Getirme

ZorBey_

Destek Ekibi

halit3

Uzman

ZorBey_

Destek Ekibi

halit3

Uzman

drykcktl

Ekli dosyalar

ZorBey_

Destek Ekibi

drykcktl

ZorBey_

Destek Ekibi

drykcktl

drykcktl

Ekli dosyalar

ZorBey_

Destek Ekibi

drykcktl

Ekli dosyalar

nane

ZorBey_

Destek Ekibi

drykcktl

ZorBey_

Destek Ekibi

drykcktl

drykcktl

Ekli dosyalar

ZorBey_

Destek Ekibi