• DİKKAT

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

ÇOKLU KRİTERE GÖRE RAPORLAMA YAPMAK

S

Sonarex33

Altın Üye
Katılım
30 Haziran 2016
Mesajlar
125
Excel Vers. ve Dili
office 2010 türkçe
ARKADAŞLAR ÖNCELİKLE HEPİNİZE HAYIRLI HAFTALAR DİLERİM. SİZ DEĞERLİ ÜSTALARDAN EKLİ EXCELDE YARDIMLARINIZI RİCA EDİYORUM.
 

Ekli dosyalar

Günceldir lütfen yardım edermisiniz
 
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?
 
Ömer' Alıntı:
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?
Genişletmek için tıkla ...
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
 
Ben boş hücre olarak değerlendirip ilerleyeceğim.
Not: Mesajlarınızı büyük harfle yazmamaya özen göstermenizi rica ederim.
 
Null yada nuul yazdığınız hücreleri silip deneyiniz.
Kod: 
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
 
Ömer' Alıntı:
Null yada nuul yazdığınız hücreleri silip deneyiniz.
Kod: 
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
Genişletmek için tıkla ...
hocam cahilliğimi hoş görün bunu nereye yapıştıracağım.
 
Dosyanız ektedir.
Kodları görmek için Alt+F11 ile vba ekranına geçerek Module1 de kodları görebilirsiniz.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst