belirli tarih aralığındaki belirli hücre kriterine göre verilerin arasından seçip başka sayfaya aktarması

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
35
Excel Vers. ve Dili
türkçe
MAKRO İLE YAPILMASI mümkünmü
GEREKEN RAPORLAMA SAYFASINA YUKARIDA BAŞLANĞIÇ TARİHİ VE BİTİŞ TARİHİ YAZDIĞIM
ARALIKTA VERİ SAYFAINDAKİ VERİLERİN VERİ SAYFASINDAKİ H SUTUNDAKİ KRİTERKERİN HANGİSİNİ RAPOR
SAYFASINDAKİ G2 SUTUNA YAZDIĞIMDA OTOMATİK RAPORLAMASINII İSTİYORUM

aynı kitapta makro çalışmam mevcut sayfalara aktar yapmıştım ondan hariç o kriterde bide raporlama sayfası yapmak istedim günlük yada aylık yıllık bazlık rapor alabilmek için umarım anlatabilmişimdir yardımınız için şimdiden tşk ederim..
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
27,779
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Lütfen mesajlarınızı büyük harfle yazmayınız.
 

tahsinanarat

Altın Üye
Altın Üye
Katılım
14 Mart 2005
Mesajlar
1,949
Excel Vers. ve Dili
Ofis 2019 Türkçe
Sn. @Endless033 Kodu aşağıdaki ile değiştirip deneyiniz
Kod:
Sub test()
Dim S1 As Worksheet, i As Long, S2 As Worksheet
Dim Trh1 As Date, Trh2 As Date, ISLEM As String
Set S1 = Sheets("VERİ")
Set S2 = Sheets("RAPOR")
'On Error Resume Next
Application.ScreenUpdating = False
    Trh1 = S2.[C2]
    Trh2 = S2.[E2]
    ISLEM = S2.[G2]
    a = S1.Range("A11:M" & S1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 2 To UBound(a)
        If CDate(a(i, 1)) >= Trh1 And CDate(a(i, 1)) <= Trh2 Then
            If a(i, 8) = ISLEM Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
            If ISLEM = "" Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
        End If
    Next i
    S2.Range("A8:M" & Rows.Count) = ""
    If say > 0 Then
        S2.[A8].Resize(say, UBound(a, 2)).Value = a
    End If
Application.ScreenUpdating = True
MsgBox "İşlem bitti.", vbInformation
End Sub
 

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
35
Excel Vers. ve Dili
türkçe
Sn. @Endless033 Kodu aşağıdaki ile değiştirip deneyiniz
Kod:
Sub test()
Dim S1 As Worksheet, i As Long, S2 As Worksheet
Dim Trh1 As Date, Trh2 As Date, ISLEM As String
Set S1 = Sheets("VERİ")
Set S2 = Sheets("RAPOR")
'On Error Resume Next
Application.ScreenUpdating = False
    Trh1 = S2.[C2]
    Trh2 = S2.[E2]
    ISLEM = S2.[G2]
    a = S1.Range("A11:M" & S1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 2 To UBound(a)
        If CDate(a(i, 1)) >= Trh1 And CDate(a(i, 1)) <= Trh2 Then
            If a(i, 8) = ISLEM Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
            If ISLEM = "" Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
        End If
    Next i
    S2.Range("A8:M" & Rows.Count) = ""
    If say > 0 Then
        S2.[A8].Resize(say, UBound(a, 2)).Value = a
    End If
Application.ScreenUpdating = True
MsgBox "İşlem bitti.", vbInformation
End Sub
sn tahsinanarat veri sayfaısna araya sutun ekleyeceğim zamanlar olacak sizden ricam sutun ekledikçe değiştirmem gereken kısım,bide aranacak kriter hücresinin farkı bir sutunu seçmem gereken zaman olacak formülde hangi kısımları değiştirme gerekiyor formül kısmını biraz öğretme şanşınız varmıdır.
 

tahsinanarat

Altın Üye
Altın Üye
Katılım
14 Mart 2005
Mesajlar
1,949
Excel Vers. ve Dili
Ofis 2019 Türkçe
Sn. @Endless033,
If a(i, 8) = ISLEM Then ' buradaki 8 arayacağın kriterin bulunduğu sutunu yani H sutununu anlatıyor,
S1.Range("A11:M" ' M ise son sutununu ifade ediyor.
Muhtemelen bu ikisini değiştirerek deneme yapabilirsiniz,
 

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
35
Excel Vers. ve Dili
türkçe
Sn. @Endless033 Kodu aşağıdaki ile değiştirip deneyiniz
Kod:
Sub test()
Dim S1 As Worksheet, i As Long, S2 As Worksheet
Dim Trh1 As Date, Trh2 As Date, ISLEM As String
Set S1 = Sheets("VERİ")
Set S2 = Sheets("RAPOR")
'On Error Resume Next
Application.ScreenUpdating = False
    Trh1 = S2.[C2]
    Trh2 = S2.[E2]
    ISLEM = S2.[G2]
    a = S1.Range("A11:M" & S1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 2 To UBound(a)
        If CDate(a(i, 1)) >= Trh1 And CDate(a(i, 1)) <= Trh2 Then
            If a(i, 8) = ISLEM Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
            If ISLEM = "" Then
                say = say + 1
                For j = 1 To UBound(a, 2)
                    a(say, j) = a(i, j)
                Next j
            End If
        End If
    Next i
    S2.Range("A8:M" & Rows.Count) = ""
    If say > 0 Then
        S2.[A8].Resize(say, UBound(a, 2)).Value = a
    End If
Application.ScreenUpdating = True
MsgBox "İşlem bitti.", vbInformation
End Sub
tahsinanarat bey..buna raporlu diyince veri geliyor her defasında yeni raporla yaptığımda öncekini silmek zorunda kalıyorum raporla diyince önceki getirdiği veriyi silme olasılığı mmkünmüdür..
 

tahsinanarat

Altın Üye
Altın Üye
Katılım
14 Mart 2005
Mesajlar
1,949
Excel Vers. ve Dili
Ofis 2019 Türkçe
Sn. @Endless033 benim sorguladığımda sayfa yenilenerek geliyor ama, yineden
sizde yenilenmiyor ise;

Set S2 = Sheets("RAPOR") satırından sonra aşağıdaki kodu giriniz.

S2.Range("A8:M65536").ClearContents
 
Üst