Kapalı kitapçıklardan şartlı veri alımı

[abbasonline]

Yapmak isteyipte yapamadığım şartlı aktarım ile ilgili açıklama kıyaslama sayfasında yazıyor, yardımınız için şimdiden teşekkür ederim.

 

[Orion1]

Yapmak isteyipte yapamadığım şartlı aktarım ile ilgili açıklama kıyaslama sayfasında yazıyor, yardımınız için şimdiden teşekkür ederim.

Yapmak istediğim a2 ve a3 de yazılı bulunan gün ve ay arasında, VERİ2009 ile VERİ2010 kitapçıklarının
VERİLER2009 sayfası ve VERİLER2010 sayfalarının C,D,E sütunlarında arama yaparak, c1.d1.e1 de yazılı olan kelimenin geçtiği
satırların A ile H arası ilk 8 sütundaki satırları alt alta yazmasını istiyorum.

Tarih derken veri dosyalarınızda a ve b sütununda tarihler var.Hangisi sorgulanacak?Butonlamı çalışcak kodlar?C1:E1 aralığına yazdığınız verilerden veri dosyadaki c-d-e sütunlarına bakılacak demişsiniz.3 değerin mutlaka olmasımı lazım yoksa sadece biri varsada listelencekmi?

C1 e çift tıkladığımda, A2 ve A3 de yazan gün ve ay arasındaki, her iki veri sayfasındada yazan kelimeyi arasın ve
o satırların ilk 8 (A ile H arası, H dahil) sütununda yazanları alsın
D1 ve E1 de aynı

Yukarıdaki sorunuzun devamımım yoksa ayrı bir işelmmi.Ayrıca burada tarih şartı koymamışsınız?

 

[abbasonline]

Sayın Evren bey kusura bakmayın geç açtım, (Tarih derken veri dosyalarınızda a ve b sütununda tarihler var.Hangisi sorgulanacak?Butonlamı çalışcak kodlar) tarih derken amacım her ikisi ilede sorgulamak veyahut makroda değişecek yeri belirtsenizde gerektiğinde değiştirerek sorgulamam mümkünmü, her üç veriyide ayrı ayı yani C1 yazdığımı c sütununda sorgulasın ve alt alta sıralasın C1, D1, E1 deki veriler aynı anda sorgulanmayacak her biri ayrı ayrı sorgulayacağım, C1 = C sütununu. D1 = D sütununu. E1 = E Sütununda sorgu yapacak her üçüde aynı anda olması gerekmiyor. ayrı ayrı

 

[abbasonline]

Birde C1,D1,E1 çift tıkladığımda makro çalışsın, Teşekkürler.

 

[abbasonline]

A2 ve A3 de kıyaslama sayfasında sadece gün ve ay yazılı yıl yazmıyor, çünkü veri sayfalarının birisi 2009 diğeri 2010

 

[Orion1]

Dosyanız ektedir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim sat As Long, i As Long, k As Byte, j As Byte, alan As String
Dim tar_sut As Integer
If Intersect(Target, [C1:E1]) Is Nothing Then Exit Sub
Cancel = True
If Target.Value = "" Then
    MsgBox "[ " & Target.Address & " ] adresinde aranacak değer olmalı.Aktarma yapılmadı", vbCritical, "UYARI"
    Exit Sub
End If
If Range("A2").Value < 1 And Range("A2").Value > 31 Then
    MsgBox "Gün hatalı girildi.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("A2").Select
    Exit Sub
End If
If Range("A3").Value < 1 And Range("A3").Value > 31 Then
    MsgBox "Gün hatalı girildi.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("A3").Select
    Exit Sub
End If
If Range("B2").Value < 1 And Range("B2").Value > 12 Then
    MsgBox "Ay hatalı girildi.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("B2").Select
    Exit Sub
End If
If Range("B3").Value < 1 And Range("B3").Value > 12 Then
    MsgBox "Ay hatalı girildi.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("B3").Select
    Exit Sub
End If
If Not IsNumeric(Range("E3").Value) Then
    MsgBox "E3 hücresinde yıl sayısal bir değer olmalıdır.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("E3").Select
    Exit Sub
End If
If Not IsNumeric(Range("F3").Value) Then
    MsgBox "F3 hücresinde yıl sayısal bir değer olmalıdır.Aktarma yapılmadı", vbCritical, "UYARI"
    Range("F3").Select
    Exit Sub
End If
If Range("G3").Value = "" Then
    MsgBox "Sorgulanacak tarih sütunu boş olamaz.Aktarma yapılmadı.", vbCritical, "UYARI"
    Range("G3").Select
    Exit Sub
End If
If Target.Column = 3 Then alan = "özelliği"
If Target.Column = 4 Then alan = "TASNİF"
If Target.Column = 5 Then alan = "ADI"
If Range("G3").Value = "B.TARİH" Then tar_sut = 0
If Range("G3").Value = "O.TARİH" Then tar_sut = 1
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Application.ScreenUpdating = False
Range("A7:H65536").ClearContents
sat = 7
For j = 5 To 6
    conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path _
    & "\VERİ" & Cells(3, j).Value & ".xls;extended properties=""excel 8.0;hdr=yes"""
    rs.Open "Select * from [VERİLER" & Cells(3, j).Value & "$] where " & alan & " like '%" & _
    UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ")) & "%';", _
    conn, adOpenKeyset, adLockReadOnly
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        Do While Not rs.EOF
            If Day(rs(tar_sut).Value) >= Range("A2").Value And _
            Month(rs(tar_sut).Value) >= Range("B2").Value And _
            Day(rs(tar_sut).Value) <= Range("A3").Value And _
            Month(rs(tar_sut).Value) <= Range("B3").Value Then
                For k = 1 To 8
                    Cells(sat, k).Value = rs(k - 1).Value
                Next
                sat = sat + 1
            End If
            rs.MoveNext
        Loop
    End If
    rs.Close: conn.Close
Next
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarım tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
         
End Sub

 

[abbasonline]

Evren bey çok teşekür ederim, sağolun.

 

[Orion1]

Evren bey çok teşekür ederim, sağolun.

Rica ederim.
İyi çalışmalar.