• DİKKAT

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

Sayfalardan 2 Farklı Rapor Almak

1Al2Ver

1Al2Ver

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Merhabalar,

"Giriş" ve "Çıkış" isimli sayfalardan, "RAPOR" sayfasına, seçilen aylara ve malzemeye göre 2 farklı rapor almak istiyorum,

Teşekkür ederim.
 

Ekli dosyalar

Öncelikle Rapor sayfasında A1 hücresine başlangıç ayının kaçıncı ay olduğunu bulmak için aşağıdaki formülü girin:

Kod: 
=KAÇINCI(B1;{"Ocak";"Şubat";"Mart";"Nisan";"Mayıs";"Haziran";"Temmuz";"Ağustos";"Eylül";"Ekim";"Kasım";"Aralık"};0)

Aynı şekilde B1 hücresine bitiş ayının kaçıncı ay olduğunu bulmak için aşağıdaki formülü girin:

Kod: 
=KAÇINCI(B2;{"Ocak";"Şubat";"Mart";"Nisan";"Mayıs";"Haziran";"Temmuz";"Ağustos";"Eylül";"Ekim";"Kasım";"Aralık"};0)

Maalesef bu işlemi makroda yaptıramadım, fazla da uğraşmadım, rapor kısmı daha çok uğraştırıcıydı çünkü.

Aşağıdaki kodları bir modüle kopyalayıp deneyin:

Kod: 
Sub rapor()

Set s1 = ThisWorkbook.Worksheets("Giriş")
Set s2 = ThisWorkbook.Worksheets("Çıkış")
Set s3 = ThisWorkbook.Worksheets("RAPOR")
ay1 = s3.[A1]
ay2 = s3.[A2]
grup = UCase(s3.[D1])
ürün = UCase(s3.[D2])

eskigiriş = WorksheetFunction.Max(5, s3.Cells(Rows.Count, "B").End(3).Row)
eskiçıkış = WorksheetFunction.Max(5, s3.Cells(Rows.Count, "N").End(3).Row)

s3.Range("A5:K" & eskigiriş).ClearContents
s3.Range("A5:K" & eskigiriş).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

s3.Range("M5:W" & eskiçıkış).ClearContents
s3.Range("M5:W" & eskiçıkış).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

yenigiriş = 5
For i = 2 To s1.Range("b65536").End(xlUp).Row
If Month(s1.Cells(i, "b")) <= ay2 And Month(s1.Cells(i, "b")) >= ay1 And UCase(s1.Cells(i, 3)) = grup _
And UCase(s1.Cells(i, 4)) = ürün Then
    s3.Cells(yenigiriş, "A") = yenigiriş - 4
    s3.Cells(yenigiriş, "B") = s1.Cells(i, "B")
    s3.Cells(yenigiriş, "C") = s1.Cells(i, "C")
    s3.Cells(yenigiriş, "D") = s1.Cells(i, "D")
    s3.Cells(yenigiriş, "E") = s1.Cells(i, "E")
    s3.Cells(yenigiriş, "F") = s1.Cells(i, "F")
    s3.Cells(yenigiriş, "G") = s1.Cells(i, "G")
    s3.Cells(yenigiriş, "H") = s1.Cells(i, "H")
    s3.Cells(yenigiriş, "I") = s1.Cells(i, "I")
    s3.Cells(yenigiriş, "J") = s1.Cells(i, "J")
    s3.Cells(yenigiriş, "K") = s1.Cells(i, "K")
    yenigiriş = yenigiriş + 1
End If
Next i

    s3.Range("A5:K" & yenigiriş - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With

yeniçıkış = 5
For j = 2 To s2.Range("b65536").End(xlUp).Row
If Month(s2.Cells(j, "b")) <= ay2 And Month(s2.Cells(j, "b")) >= ay1 And UCase(s2.Cells(j, 3)) = grup _
And UCase(s2.Cells(j, 4)) = ürün Then
    s3.Cells(yeniçıkış, "M") = yeniçıkış - 4
    s3.Cells(yeniçıkış, "N") = s2.Cells(j, "B")
    s3.Cells(yeniçıkış, "O") = s2.Cells(j, "C")
    s3.Cells(yeniçıkış, "P") = s2.Cells(j, "D")
    s3.Cells(yeniçıkış, "Q") = s2.Cells(j, "E")
    s3.Cells(yeniçıkış, "R") = s2.Cells(j, "F")
    s3.Cells(yeniçıkış, "S") = s2.Cells(j, "G")
    s3.Cells(yeniçıkış, "T") = s2.Cells(j, "H")
    s3.Cells(yeniçıkış, "U") = s2.Cells(j, "I")
    s3.Cells(yeniçıkış, "V") = s2.Cells(j, "J")
    s3.Cells(yeniçıkış, "W") = s2.Cells(j, "K")
    yeniçıkış = yeniçıkış + 1
End If
Next j

    s3.Range("M5:W" & yeniçıkış - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With

Call sıralaa
End Sub

Sub sıralaa()
    Range("A5:K1000").Select
    Selection.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Range("M5:w1000").Select
    Selection.Sort Key1:=Range("N5"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A5").Select
End Sub
 
Sayın Yusuf44 merhaba,

Zahmetleriniz ve ilginiz için ne kadar teşekkür etsem azdır, gerçekten çok emeğiniz var, tekrar teşekkür ederim.

Sevgi ve saygılarımla.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst