kaçıncı satırda uyarı var listelemek

[siyar0044]

merhabalar
ekli dosya
ah1 hücresinde bugünün tarihi yazılıyor
AH2 hücresindeki formül (w veya AC hücresinde değer varsa AD hücresinde mutlaka açıklama olmalı açıklam yoksa uyarı veriyor)
AH3 hücresindeki formül (ah1 hücresi bugünün tarihini veriyor C sütununda borç ve alacakların tarihleri AD sütununda ise ödenip ödenmediğini gösteriyor (günü geçmiş ve ödenmedi ibaresi varsa uyarı veriyor)

formüller çalışıyor sıkıntı yok yapmak istediğim EĞER AH2 VE AH3 Hücrelerinde uyarı verirse bunun kaçıncı satırlarda uyarı verdiğini gösteren bir sistem yapmak (birden fazla yerden uyarı veriyorsa hepsini listelenecek)
yardımcı olabilirseniz sevinirim

2_tarih_filtre__v.9__-_Kopya.xlsm dosyasını indir - download

2_tarih_filtre__v.9__-_Kopya.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[AdemCan]

Merhaba, resimdeki gibi AJ1 ve AK1 hücrelerine başlık oluşturup kodu çalıştırınız.

Spoyler: Başlık

Sub test_kontrol()

Dim s1 As Worksheet, aciklama As String, odeme As String

Set s1 = Sayfa1
aciklama = s1.Range("AH3")
odeme = s1.Range("AH4")
son = s1.Cells(Rows.Count, 3).End(3).Row

s1.Range("AJ2:AJ" & son + 1).Clear
s1.Range("AK2:AK" & son + 1).Clear

If aciklama = "Eksik Açıklama var" Then
    ad = WorksheetFunction.CountIfs(s1.Range("W21:W" & son), _
                                    "<>", s1.Range("AC21:AC" & son), _
                                    "<>", s1.Range("AD21:AD" & son), "")

    ReDim liste(ad)
    ad = 1
    For i = 21 To son
        If Cells(i, "AD") = "" Then
            liste(ad) = s1.Range("AD" & i).Address
            ad = ad + 1
        End If
    Next i
   
    For j = 1 To UBound(liste)
        s1.Cells(j + 1, "AJ") = liste(j)
    Next j
End If

If odeme = "Ödenmemiş Evrak Var" Then
    ad = WorksheetFunction.CountIf(s1.Range("AD21:AD" & son), "ödenmedi")

    ReDim liste(ad)
    ad = 1
    For i = 21 To son
        If Cells(i, "AD") = "ödenmedi" Then
            liste(ad) = s1.Range("AD" & i).Address
            ad = ad + 1
        End If
    Next i
   
    For j = 1 To UBound(liste)
        s1.Cells(j + 1, "AK") = liste(j)
    Next j
End If

End Sub

Spoyler: Sonuç

 

[siyar0044]

Merhaba, resimdeki gibi AJ1 ve AK1 hücrelerine başlık oluşturup kodu çalıştırınız.

Spoyler: Başlık

Ekli dosyayı görüntüle 237852

Sub test_kontrol()

Dim s1 As Worksheet, aciklama As String, odeme As String

Set s1 = Sayfa1
aciklama = s1.Range("AH3")
odeme = s1.Range("AH4")
son = s1.Cells(Rows.Count, 3).End(3).Row

s1.Range("AJ2:AJ" & son + 1).Clear
s1.Range("AK2:AK" & son + 1).Clear

If aciklama = "Eksik Açıklama var" Then
    ad = WorksheetFunction.CountIfs(s1.Range("W21:W" & son), _
                                    "<>", s1.Range("AC21:AC" & son), _
                                    "<>", s1.Range("AD21:AD" & son), "")

    ReDim liste(ad)
    ad = 1
    For i = 21 To son
        If Cells(i, "AD") = "" Then
            liste(ad) = s1.Range("AD" & i).Address
            ad = ad + 1
        End If
    Next i
  
    For j = 1 To UBound(liste)
        s1.Cells(j + 1, "AJ") = liste(j)
    Next j
End If

If odeme = "Ödenmemiş Evrak Var" Then
    ad = WorksheetFunction.CountIf(s1.Range("AD21:AD" & son), "ödenmedi")

    ReDim liste(ad)
    ad = 1
    For i = 21 To son
        If Cells(i, "AD") = "ödenmedi" Then
            liste(ad) = s1.Range("AD" & i).Address
            ad = ad + 1
        End If
    Next i
  
    For j = 1 To UBound(liste)
        s1.Cells(j + 1, "AK") = liste(j)
    Next j
End If

End Sub

Spoyler: Sonuç

Ekli dosyayı görüntüle 237853

teşekkür ederim elinize sağlık

 

[AdemCan]

Rica ederim.