ÇOKLU KRİTERE GÖRE RAPORLAMA YAPMAK

[Sonarex33]

ARKADAŞLAR ÖNCELİKLE HEPİNİZE HAYIRLI HAFTALAR DİLERİM. SİZ DEĞERLİ ÜSTALARDAN EKLİ EXCELDE YARDIMLARINIZI RİCA EDİYORUM.

 

[Sonarex33]

Günceldir lütfen yardım edermisiniz

 

[Ömer]

Merhaba,

Tarih olamayan (Boş) hücrelerde "null" ve "nuul" değerleri var.
Bu hücreler veri çektiğinizde böyle mi geliyor yoksa boş geldiği için siz elle mi yazdınız bu değerleri.

Ayrıca zaman aşımı sütunundaki tarihler otomatik mi geliyor? Yoksa bunlarında hesaplanması mı gerek li?

 

[Sonarex33]

Merhaba,

Tarih olamayan (Boş) hücrelerde "null" ve "nuul" değerleri var.
Bu hücreler veri çektiğinizde böyle mi geliyor yoksa boş geldiği için siz elle mi yazdınız bu değerleri.

Ayrıca zaman aşımı sütunundaki tarihler otomatik mi geliyor? Yoksa bunlarında hesaplanması mı gerek li?

HOCAM TARİH OLMAYAN BOŞ HÜCRELER DE VERİ GİRİŞİ OLMADIĞI İÇİN BEN ELLE YAZDIM.ZAMAN AŞIMI 5 YILA DENK GELEN TARİHİN SONU OLACAK HEP. BUNLARIN HESAPLANMASI GEREKİYOR. BEN MAUEL HESAPLADIM

 

[Ömer]

Ben boş hücre olarak değerlendirip ilerleyeceğim.
Not: Mesajlarınızı büyük harfle yazmamaya özen göstermenizi rica ederim.

 

[Sonarex33]

Ben boş hücre olarak değerlendirip ilerleyeceğim.
Not: Mesajlarınızı büyük harfle yazmamaya özen göstermenizi rica ederim.

Özür dilerim. daha dikkatli olacağım

 

[Ömer]

Null yada nuul yazdığınız hücreleri silip deneyiniz.

Sub test()

    Dim ara As Worksheet, zaman As Worksheet, teblig As Worksheet, sure As Worksheet, genel As Worksheet
    Dim i As Long, c As Range, Adr As String, syf As Worksheet
    Dim son_zaman As Long, son_teblig As Long, son_sure As Long
   
    Set ara = Sheets("ARANACAKLAR")
    Set zaman = Sheets("zaman aşımı ")
    Set teblig = Sheets("tebliğ edilemeyenler")
    Set sure = Sheets("zaman aşımı süresi uzayanlar")
    Set genel = Sheets("genel liste")
   
    Application.ScreenUpdating = False
   
    For Each syf In ThisWorkbook.Worksheets
        Select Case syf.Name
            Case zaman.Name, teblig.Name, sure.Name
            syf.Range("A2:E" & Rows.Count).ClearContents
        End Select
    Next
   
    For i = 2 To ara.Cells(Rows.Count, "A").End(xlUp).Row
        Set c = genel.[A:A].Find(ara.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If genel.Cells(i, "C") = "" Then
                    son_zaman = zaman.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    zaman.Cells(son_zaman, "A") = genel.Cells(c.Row, "A")
                    zaman.Cells(son_zaman, "B") = genel.Cells(c.Row, "B")
                End If
                If genel.Cells(i, "C") <> "" And genel.Cells(i, "D") = "" Then
                    son_teblig = teblig.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    teblig.Cells(son_teblig, "A") = genel.Cells(c.Row, "A")
                    teblig.Cells(son_teblig, "B") = genel.Cells(c.Row, "B")
                    teblig.Cells(son_teblig, "C") = genel.Cells(c.Row, "C")
                End If
                If genel.Cells(i, "D") <> "" Then
                    genel.Cells(c.Row, "E") = "31.12." & Year(genel.Cells(c.Row, "D")) + 5
                    son_sure = sure.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    sure.Cells(son_sure, "A") = genel.Cells(c.Row, "A")
                    sure.Cells(son_sure, "B") = genel.Cells(c.Row, "B")
                    sure.Cells(son_sure, "C") = genel.Cells(c.Row, "C")
                    sure.Cells(son_sure, "D") = genel.Cells(c.Row, "D")
                    sure.Cells(son_sure, "E") = genel.Cells(c.Row, "E")
                End If
                Set c = genel.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
   
    MsgBox "İşleminiz Bitti.", vbInformation
    Application.ScreenUpdating = True
   
End Sub

 

[Sonarex33]

Null yada nuul yazdığınız hücreleri silip deneyiniz.

Sub test()

    Dim ara As Worksheet, zaman As Worksheet, teblig As Worksheet, sure As Worksheet, genel As Worksheet
    Dim i As Long, c As Range, Adr As String, syf As Worksheet
    Dim son_zaman As Long, son_teblig As Long, son_sure As Long
  
    Set ara = Sheets("ARANACAKLAR")
    Set zaman = Sheets("zaman aşımı ")
    Set teblig = Sheets("tebliğ edilemeyenler")
    Set sure = Sheets("zaman aşımı süresi uzayanlar")
    Set genel = Sheets("genel liste")
  
    Application.ScreenUpdating = False
  
    For Each syf In ThisWorkbook.Worksheets
        Select Case syf.Name
            Case zaman.Name, teblig.Name, sure.Name
            syf.Range("A2:E" & Rows.Count).ClearContents
        End Select
    Next
  
    For i = 2 To ara.Cells(Rows.Count, "A").End(xlUp).Row
        Set c = genel.[A:A].Find(ara.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If genel.Cells(i, "C") = "" Then
                    son_zaman = zaman.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    zaman.Cells(son_zaman, "A") = genel.Cells(c.Row, "A")
                    zaman.Cells(son_zaman, "B") = genel.Cells(c.Row, "B")
                End If
                If genel.Cells(i, "C") <> "" And genel.Cells(i, "D") = "" Then
                    son_teblig = teblig.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    teblig.Cells(son_teblig, "A") = genel.Cells(c.Row, "A")
                    teblig.Cells(son_teblig, "B") = genel.Cells(c.Row, "B")
                    teblig.Cells(son_teblig, "C") = genel.Cells(c.Row, "C")
                End If
                If genel.Cells(i, "D") <> "" Then
                    genel.Cells(c.Row, "E") = "31.12." & Year(genel.Cells(c.Row, "D")) + 5
                    son_sure = sure.Cells(Rows.Count, "A").End(xlUp).Row + 1
                    sure.Cells(son_sure, "A") = genel.Cells(c.Row, "A")
                    sure.Cells(son_sure, "B") = genel.Cells(c.Row, "B")
                    sure.Cells(son_sure, "C") = genel.Cells(c.Row, "C")
                    sure.Cells(son_sure, "D") = genel.Cells(c.Row, "D")
                    sure.Cells(son_sure, "E") = genel.Cells(c.Row, "E")
                End If
                Set c = genel.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
  
    MsgBox "İşleminiz Bitti.", vbInformation
    Application.ScreenUpdating = True
  
End Sub

hocam cahilliğimi hoş görün bunu nereye yapıştıracağım.

 

[Ömer]

Dosyanız ektedir.
Kodları görmek için Alt+F11 ile vba ekranına geçerek Module1 de kodları görebilirsiniz.

 

[Sonarex33]

Dosyanız ektedir.
Kodları görmek için Alt+F11 ile vba ekranına geçerek Module1 de kodları görebilirsiniz.

Teşekkür ederim hocam elinize emeğinize sağlık