• DİKKAT

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

Kritere uyan satırları getirme

T

turguturgut

Katılım
10 Ocak 2013
Mesajlar
97
Excel Vers. ve Dili
2013 versiyon
Sayın Hocam merhabalar..

Ekteki dosyamda sipariş isimli sayfada sipariş bilgileri var.
rapor rapor isimli sayfada ise FİRMA ADI, TARİH ARALIĞI gireceğim 3 hücre var. Ben istiyorum ki bu 3 kritere uyan siparişler sayfasındaki satırlar gelsin. Kritere uyan satırlar raporlar sayfasındaki yeşil renkli hücrelerin altına yazılabilir.

Çok teşekkürler..
 

Ekli dosyalar

Aşağıdaki kodları kullanabilirsiniz.
Kod: 
Sub ASKM_Tarih_Araligi_Getir()
Dim s1, s2 As Worksheet
Dim SonSat As Long
Dim baslangic, bitis As Date

Set s1 = Worksheets("siparişler")
Set s2 = Worksheets("rapor")
Dim tarih1, tarih2
tarih1 = CDate(s2.Cells(2, 2))
tarih2 = CDate(s2.Cells(3, 2))
baslangic = Time
s2.Range("A10:H65000").ClearContents
SonSat = s1.Range("A" & Rows.Count).End(xlUp).Row
x = 10
For i = 2 To SonSat
    If tarih1 <= CDate(s1.Cells(i, 2)) And tarih2 >= CDate(s1.Cells(i, 2)) Then
        s2.Cells(x, 1) = s1.Cells(i, 1)
        s2.Cells(x, 2) = Format(s1.Cells(i, 2), "dd.mm.yyyy")
        s2.Cells(x, 3) = Format(s1.Cells(i, 3), "dd.mm.yyyy")
        s2.Cells(x, 4) = s1.Cells(i, 4)
        s2.Cells(x, 5) = s1.Cells(i, 5)
        s2.Cells(x, 6) = s1.Cells(i, 6)
        s2.Cells(x, 7) = s1.Cells(i, 7)
        s2.Cells(x, 8) = s1.Cells(i, 8)
        x = x + 1
    End If
Next
bitis = Time
MsgBox Format(bitis - baslangic, "hh:mm:ss") & " Sürede İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "ASKM"
End Sub
 
askm' Alıntı:
Aşağıdaki kodları kullanabilirsiniz.
Kod: 
Sub ASKM_Tarih_Araligi_Getir()
Dim s1, s2 As Worksheet
Dim SonSat As Long
Dim baslangic, bitis As Date

Set s1 = Worksheets("siparişler")
Set s2 = Worksheets("rapor")
Dim tarih1, tarih2
tarih1 = CDate(s2.Cells(2, 2))
tarih2 = CDate(s2.Cells(3, 2))
baslangic = Time
s2.Range("A10:H65000").ClearContents
SonSat = s1.Range("A" & Rows.Count).End(xlUp).Row
x = 10
For i = 2 To SonSat
    If tarih1 <= CDate(s1.Cells(i, 2)) And tarih2 >= CDate(s1.Cells(i, 2)) Then
        s2.Cells(x, 1) = s1.Cells(i, 1)
        s2.Cells(x, 2) = Format(s1.Cells(i, 2), "dd.mm.yyyy")
        s2.Cells(x, 3) = Format(s1.Cells(i, 3), "dd.mm.yyyy")
        s2.Cells(x, 4) = s1.Cells(i, 4)
        s2.Cells(x, 5) = s1.Cells(i, 5)
        s2.Cells(x, 6) = s1.Cells(i, 6)
        s2.Cells(x, 7) = s1.Cells(i, 7)
        s2.Cells(x, 8) = s1.Cells(i, 8)
        x = x + 1
    End If
Next
bitis = Time
MsgBox Format(bitis - baslangic, "hh:mm:ss") & " Sürede İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "ASKM"
End Sub
Genişletmek için tıkla ...

Çok teşekkür ederim ancak nasıl yapacağımı anlamadım.. Bu kodları boş bir makro oluşturup içine mi yapıştırayım..Makronun adı ne vermeliyim
 
Bu gibi işlemlerde formül değil de makro kullanmak dosyanın hantallaşmasını önler.

Dosyanızda iken Alt+F11 yaparak ya da sayfa sekmesine sağ tıklayıp Kod Görüntüle diyerek VBA sayfasına geçin.

Verilen kodları kopyalayın.

VBA sayfasında Insert menüsünden Module'yi seçin

Açılan sayfaya bu kodları yapıştırın.

Normal çalışma sayfanıza geçin.

Sayfaya bir resim/düğme/nesne ekleyin

Eklediğiniz resim/düğme/nesneye sağ tıklayıp Makro ata deyin

Çıkan listede ASKM_Tarih_Araligi_Getir makrosunu seçin.

Bundan sonra makroları etkinleştirdiğinizde o resim/düğme/nesneye her basışınızda makro çalışacaktır.

Makronun daha sonraki açılışlarda da çalışması için dosyanızı Makro İçerebilen Excel Dosyası olarak kaydetmeyi unutmayınız (uzantısı xlsm olacak).
 
yusuf44' Alıntı:
bu gibi işlemlerde formül değil de makro kullanmak dosyanın hantallaşmasını önler.

Dosyanızda iken alt+f11 yaparak ya da sayfa sekmesine sağ tıklayıp kod görüntüle diyerek vba sayfasına geçin.

Verilen kodları kopyalayın.

Vba sayfasında ınsert menüsünden module'yi seçin

açılan sayfaya bu kodları yapıştırın.

Normal çalışma sayfanıza geçin.

Sayfaya bir resim/düğme/nesne ekleyin

eklediğiniz resim/düğme/nesneye sağ tıklayıp makro ata deyin

çıkan listede askm_tarih_araligi_getir makrosunu seçin.

Bundan sonra makroları etkinleştirdiğinizde o resim/düğme/nesneye her basışınızda makro çalışacaktır.

Makronun daha sonraki açılışlarda da çalışması için dosyanızı makro içerebilen excel dosyası olarak kaydetmeyi unutmayınız (uzantısı xlsm olacak).
Genişletmek için tıkla ...

merhaba aynen uyguladım düğmeye bastığımda şu hatayı veriyor..hata resmi ekte
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    96.7 KB · Görüntüleme: 2
En baştaki Option Explicit kısmını silin.
 
Firma kısmını görmemişim.
Kod: 
Sub ASKM_Tarih_Araligi_Getir()
Dim s1, s2 As Worksheet
Dim SonSat As Long
Dim baslangic, bitis As Date

Set s1 = Worksheets("siparişler")
Set s2 = Worksheets("rapor")
Dim tarih1, tarih2
firma = s2.Cells(1, 2)
tarih1 = CDate(s2.Cells(2, 2))
tarih2 = CDate(s2.Cells(3, 2))
baslangic = Time
s2.Range("A10:H65000").ClearContents
SonSat = s1.Range("A" & Rows.Count).End(xlUp).Row
x = 10
For i = 2 To SonSat
    If tarih1 <= CDate(s1.Cells(i, 2)) And tarih2 >= CDate(s1.Cells(i, 2)) And firma = s1.Cells(i, 4) Then
        s2.Cells(x, 1) = s1.Cells(i, 1)
        s2.Cells(x, 2) = Format(s1.Cells(i, 2), "dd.mm.yyyy")
        s2.Cells(x, 3) = Format(s1.Cells(i, 3), "dd.mm.yyyy")
        s2.Cells(x, 4) = s1.Cells(i, 4)
        s2.Cells(x, 5) = s1.Cells(i, 5)
        s2.Cells(x, 6) = s1.Cells(i, 6)
        s2.Cells(x, 7) = s1.Cells(i, 7)
        s2.Cells(x, 8) = s1.Cells(i, 8)
        x = x + 1
    End If
Next
bitis = Time
MsgBox Format(bitis - baslangic, "hh:mm:ss") & " Sürede İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "ASKM"
End Sub
 
askm' Alıntı:
Firma kısmını görmemişim.
Kod: 
Sub ASKM_Tarih_Araligi_Getir()
Dim s1, s2 As Worksheet
Dim SonSat As Long
Dim baslangic, bitis As Date

Set s1 = Worksheets("siparişler")
Set s2 = Worksheets("rapor")
Dim tarih1, tarih2
firma = s2.Cells(1, 2)
tarih1 = CDate(s2.Cells(2, 2))
tarih2 = CDate(s2.Cells(3, 2))
baslangic = Time
s2.Range("A10:H65000").ClearContents
SonSat = s1.Range("A" & Rows.Count).End(xlUp).Row
x = 10
For i = 2 To SonSat
    If tarih1 <= CDate(s1.Cells(i, 2)) And tarih2 >= CDate(s1.Cells(i, 2)) And firma = s1.Cells(i, 4) Then
        s2.Cells(x, 1) = s1.Cells(i, 1)
        s2.Cells(x, 2) = Format(s1.Cells(i, 2), "dd.mm.yyyy")
        s2.Cells(x, 3) = Format(s1.Cells(i, 3), "dd.mm.yyyy")
        s2.Cells(x, 4) = s1.Cells(i, 4)
        s2.Cells(x, 5) = s1.Cells(i, 5)
        s2.Cells(x, 6) = s1.Cells(i, 6)
        s2.Cells(x, 7) = s1.Cells(i, 7)
        s2.Cells(x, 8) = s1.Cells(i, 8)
        x = x + 1
    End If
Next
bitis = Time
MsgBox Format(bitis - baslangic, "hh:mm:ss") & " Sürede İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "ASKM"
End Sub
Genişletmek için tıkla ...

ÇOK SAĞOLUN HOCAM..

BİR ŞEY DAHA SORACAĞIM.. bu benim deneme sayfası idi..Aslında kriter girdiğimizde getireceği satırlar başka sayfada.. O başka sayfanın yolunu bu verdiğiniz kodlarda nasıl yazmalıyım * Bir örnek ile açıklarsanız ben onu uygualarım benim sayfalara
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst