2 Tarih arası Açılır Kutu'yla Veri Almak

[1Al2Ver]

Merhaba,

2 tarih (ay) arası, açılır kutudan seçim yaparak, diğer sayfadan veri almak istiyorum,

Ek'li dosyadaki makroya yapılacak ilave ile olabiliyor mu ? Olabiliyor ise ilaveyi rica ediyorum.

Teşekkür ederim.

 

[halit3]

kod:

Sub aktar()

ReDim ay(12)

ay(1) = "Ocak"
ay(2) = "Şubat"
ay(3) = "Mart"
ay(4) = "Nisan"
ay(5) = "Mayıs"
ay(6) = "Haziran"
ay(7) = "Temmuz"
ay(8) = "Ağustos"
ay(9) = "Eylül"
ay(10) = "Ekim"
ay(11) = "Kasım"
ay(12) = "Aralık"


sat = 2

baslangıc2 = Sheets("Pazarlamacı").Cells(4, "m").Value

For s = 1 To 12
If baslangıc2 = ay(s) Then
baslangıc = s
Exit For
End If
Next s

bitis2 = Sheets("Pazarlamacı").Cells(6, "m").Value

For s = 1 To 12
If bitis2 = ay(s) Then
bitis = s
Exit For
End If
Next s

Sheets("Pazarlamacı").Range("A2:E500").ClearContents

deg1 = baslangıc
deg2 = bitis

If deg1 <= deg2 Then
yer1 = baslangıc
yer2 = bitis
Else
yer2 = baslangıc
yer1 = bitis
End If

If baslangıc > 0 Then
If bitis > 0 Then

aranan1 = Sheets("Pazarlamacı").Cells(2, "m").Value
For r = 2 To Worksheets("SATIŞLAR").Cells(Rows.Count, "a").End(3).Row
aranan2 = Sheets("SATIŞLAR").Cells(r, "a").Value

bulunan1 = Val(Format(Sheets("SATIŞLAR").Cells(r, "b").Value, "mm"))
If yer1 <= bulunan1 And yer2 >= bulunan1 Then

If aranan2 = aranan1 Then

Sheets("Pazarlamacı").Cells(sat, "a").Value = Sheets("SATIŞLAR").Cells(r, "a").Value
Sheets("Pazarlamacı").Cells(sat, "b").Value = Sheets("SATIŞLAR").Cells(r, "b").Value
Sheets("Pazarlamacı").Cells(sat, "c").Value = Sheets("SATIŞLAR").Cells(r, "c").Value
Sheets("Pazarlamacı").Cells(sat, "d").Value = Sheets("SATIŞLAR").Cells(r, "d").Value
Sheets("Pazarlamacı").Cells(sat, "e").Value = Sheets("SATIŞLAR").Cells(r, "e").Value
sat = sat + 1
End If
End If

Next r
End If
End If


End Sub

 

[omerceri]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [M2]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
 
   Sheets("Pazarlamacı").Range("A2:E35000").ClearContents
  ilk = DateValue("01 " & Range("M4") & " 2011")
son = DateValue("01 " & Range("M6") & " 2011")
son = DateValue(Format((DateSerial(Year(son), Month(son) + 1, 1)) - 1, "dd/mm/yyyy"))

müm = Sheets("Pazarlamacı").Range("M2")
Sql1 = "SELECT [Satış Mümessili], [Tarih], [Şehir], [Satılan Ürün],[Tutar] As Bayir FROM [SATIŞLAR$] WHERE [Satış Mümessili]='" & müm & "' AND [Tarih]>=" & CDbl(ilk) & " AND [Tarih]<=" & CDbl(son)
Dim cn As Object, rs As Object



Set cn = CreateObject("ADODB.Connection")
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & ThisWorkbook.FullName

Set rs = CreateObject("ADODB.Recordset")
rs.Open Sql1, cn

Sheets("Pazarlamacı").[a2].CopyFromRecordset rs

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Çözüm ve ilgin için teşekkür ederim,

Başlama-Bitim aylarını seçtikten sonra M2'den isim seçince makro'nun etkin olmasını sağlayabilir miyiz ?

Bu durumda ayrıca bir düğmeye gerek kalmaz, olabilir mi ?

Teşekkür ederim.

 

[1Al2Ver]

ADO ile yapılmaya çalıştığım bir örnek vardı, yanlışmış düzeltince eklerim.

Sayın Ömer Çeri merhaba,

İlginiz için teşekkür ederim,

her 2 tarihi seçtikten sonra isim seçtiğimde makronun çalışmasını arzuluyorum, olabiliyor ise tabi.

Tekrar teşekkür ederim.

 

[halit3]

Sayın halit3 merhaba,

Çözüm ve ilgin için teşekkür ederim,

Başlama-Bitim aylarını seçtikten sonra M2'den isim seçince makro'nun etkin olmasını sağlayabilir miyiz ?

Bu durumda ayrıca bir düğmeye gerek kalmaz, olabilir mi ?

Teşekkür ederim.

Sayfanın kod bölümünü bununla değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [M2]) Is Nothing Then Exit Sub
aktar
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Kodu uyguladım sorun yok, sağ olun.

Tekrar teşekkür ederim.

 

[omerceri]

Yukarıya ekledim düzeltilmiş kodları

 

[1Al2Ver]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [M2]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
 
   Sheets("Pazarlamacı").Range("A2:E35000").ClearContents
  ilk = DateValue("01 " & Range("M4") & " 2011")
son = DateValue("01 " & Range("M6") & " 2011")
son = DateValue(Format((DateSerial(Year(son), Month(son) + 1, 1)) - 1, "dd/mm/yyyy"))

müm = Sheets("Pazarlamacı").Range("M2")
Sql1 = "SELECT [Satış Mümessili], [Tarih], [Şehir], [Satılan Ürün],[Tutar] As Bayir FROM [SATIŞLAR$] WHERE [Satış Mümessili]='" & müm & "' AND [Tarih]>=" & CDbl(ilk) & " AND [Tarih]<=" & CDbl(son)
Dim cn As Object, rs As Object



Set cn = CreateObject("ADODB.Connection")
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & ThisWorkbook.FullName

Set rs = CreateObject("ADODB.Recordset")
rs.Open Sql1, cn

Sheets("Pazarlamacı").[a2].CopyFromRecordset rs

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

Sayın Ömer Çeri, merhaba,

İlginiz için teşekkür ederim,

Kodları sayfa ekleyerek te düzenledim, sorunsuz çalışıyor, sağ olun.

Tekrar teşekkürler...