• DİKKAT

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

formüle göre sütun kontrol ve şartlara uymuyorsa uyarı vermesi.

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
alt alta listemde sütunlar arasında her satırı aşağıdaki şartlar ile kontrol edecek ve bu şartlara uyan varsa msgbox ile uyarı verecek bir kod nasıl yazılır. (msgbox a bu şartları sağlayanların satır numarası da eklenebilirse muhteşem olur.)
şartlarım ve mesajlarım şu şekilde olacak...
V:V-X:X-AD-AH < 0 ise "hedef fazla"
V:V-X:X-AD-AR<0 ise "pb geçti"
E:E="tamamlandı" ise ve V:V-Y:Y-AU:AU>0 ise "kh pb kontrol"
 
Merhaba,
Aşağıdaki kodu deneyiniz, mesaj kutusundan sonra kodu sonlandırmak isterseniz msgbox ile başlayan satırların altına Exit Sub satırı ekleyiniz.
İyi çalışmalar...
PHP: 
Sub kod()
For a = 2 To Cells(Rows.Count, "V").End(3).Row
    If Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AH") < 0 Then
        MsgBox "Hedef fazla" & vbLf & "Satır no: " & a
    ElseIf Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AR") < 0 Then
        MsgBox "pb geçti" & vbLf & "Satır no: " & a
    ElseIf Cells(a, "E") = "tamamlandı" And Cells(a, "V") - Cells(a, "Y") - Cells(a, "AU") > 0 Then
        MsgBox "kh pb kontrol" & vbLf & "Satır no: " & a
    End If
Next
End Sub
 
ÖmerBey' Alıntı:
Merhaba,
Aşağıdaki kodu deneyiniz, mesaj kutusundan sonra kodu sonlandırmak isterseniz msgbox ile başlayan satırların altına Exit Sub satırı ekleyiniz.
İyi çalışmalar...
PHP: 
Sub kod()
For a = 2 To Cells(Rows.Count, "V").End(3).Row
    If Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AH") < 0 Then
        MsgBox "Hedef fazla" & vbLf & "Satır no: " & a
    ElseIf Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AR") < 0 Then
        MsgBox "pb geçti" & vbLf & "Satır no: " & a
    ElseIf Cells(a, "E") = "tamamlandı" And Cells(a, "V") - Cells(a, "Y") - Cells(a, "AU") > 0 Then
        MsgBox "kh pb kontrol" & vbLf & "Satır no: " & a
    End If
Next
End Sub
Genişletmek için tıkla ...

teşekkürler. Yine üşenmeden yazdınız...

Kod: 
Private Sub Workbook_Open()
Set gt = Sheets("gt")
If WorksheetFunction.CountIfs(gt.Range("E:E"), "İlanda", gt.Range("N:N"), "<" & CDbl(Date)) > 0 Then
    cvp = MsgBox("İhale Tarihi Geçmiş İşler Var." & vbLf & "Göster?", vbCritical Or vbYesNo)
    If cvp = vbYes Then
        gt.Range("$A$2:$N$1600").AutoFilter Field:=5, Criteria1:="İlanda"
        gt.Range("$A$2:$N$1600").AutoFilter Field:=14, Criteria1:="<" & CDbl(Date)

    
ElseIf cvp = vbNo Then
MsgBox "not alalım!!!", vbMsgBoxSetForeground
Exit Sub

    End If
End If
End Sub

yine sizin daha önce yazdığınız koda ekleyebilir misiniz. açılışta sorması için. bir de satırları toplu olarak yazdırma şansımız var mı. tablo kalabalık olunca bayağı bir msgbox çıkabilir. :)
 
Rica ederim, ama mesaj kutusunu siz istemiştiniz.
Aşağıdaki kodları boş bir modüle kopyalayınız. Ana dosyanızın olduğu dizinde, içerisinde satır numaralarının olduğu Rapor.txt adında bir dosya oluşturur. Yukarıdaki koda da Call Rapor satırı ekleyerek istediğiniz yerinde kodun çalışmasını sağlayabilirsiniz. İyi geceler, iyi çalışmalar...
PHP: 
Sub Rapor()
Open ThisWorkbook.Path & "\Rapor.txt" For Output As #1
For a = 2 To Cells(Rows.Count, "V").End(3).Row
    If Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AH") < 0 Then
        Print #1, "Hedef fazla", "Satır no: " & a
    ElseIf Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AR") < 0 Then
        Print #1, "pb geçti", "Satır no: " & a
    ElseIf Cells(a, "E") = "tamamlandı" And Cells(a, "V") - Cells(a, "Y") - Cells(a, "AU") > 0 Then
        Print #1, "kh pb kontrol", "Satır no: " & a
    End If
Next
Close #1
End Sub
 
merhaba. bir şey farkettim. dosyam başka sekmedeyken kaydedildiyse
If Cells(a, "V") - Cells(a, "X") - Cells(a, "AD") - Cells(a, "AH") < 0 Then
kısmı hata veriyor. gt sekmesindeyken kodu çalıştırdığımda sorun çıkmıyor. bunu nasıl düzeltmeliyim. bir de rapor dosyası oluşturuldu msgbox olarak nasıl gösterilebilir.
 
Merhabalar.
Sayın adaşım @ÖmerBey şu an çevrimiçi değil.

Kendisinin müsadeleriyle ve anladığım kadarıyla; yapılacak işlemi tarif edeyim.
-- başka sayfa aktif iken de verilen kod'un aynı şekilde çalışabilmesi için:
Sub Rapor() //// Open........ satırlarnın arasına Set gt = Sheets("gt") şeklinde yeni bir satır ekleyip,
kod'daki tüm Cells(.... ibarelerinin başına gt.Cells(..... şeklinde ekleme yapılması,
-- msgbox ile işlem sonucunun bildirilmesi için de; End Sub satırının hemen üstüne MsgBox "İşlem tamamlandı..." şeklinde bir satır eklenmesi,
yeterli olacaktır.
.
 
Ömer BARAN' Alıntı:
Merhabalar.
Sayın adaşım @ÖmerBey şu an çevrimiçi değil.

Kendisinin müsadeleriyle ve anladığım kadarıyla; yapılacak işlemi tarif edeyim.
-- başka sayfa aktif iken de verilen kod'un aynı şekilde çalışabilmesi için:
Sub Rapor() //// Open........ satırlarnın arasına Set gt = Sheets("gt") şeklinde yeni bir satır ekleyip,
kod'daki tüm Cells(.... ibarelerinin başına gt.Cells(..... şeklinde ekleme yapılması,
-- msgbox ile işlem sonucunun bildirilmesi için de; End Sub satırının hemen üstüne MsgBox "İşlem tamamlandı..." şeklinde bir satır eklenmesi,
yeterli olacaktır.
.
Genişletmek için tıkla ...
teşekkürler. bu konu ile ilgili son olarak bir şey isteyeceğim.
ElseIf gt.Cells(a, "E") = "İlanda" And gt.Cells(a, "N") < CDbl(Date) Then Print #1, "İhalesi yapılıp, işlenmeyenler var", "Satır no: " & a End If
kısmını ekleyince hata veriyor. e sütununda ilanda yazıp n sütununda bugünün tarihinden küçük olanlar varsa onları da rapora yazsın istiyorum. bu kodla olmadı. en son olarak da işlem tamamlandığında rapor.txt önce kaydedilsin sonra açık kalsın istiyorum. kapanmasın. selamlar...
 
Sorunun kaynağı tarih ile ilgili olabilir.
İsterseniz ilgili kısmı aşağıdaki değiştirerek deneyin.
ElseIf gt.Cells(a, "E") = "İlanda" And CDbl(DateValue(gt.Cells(a, "N") .Value)) < CDbl(Date) Then
Genişletmek için tıkla ...
Sonuç alamazsanız; If .... Elseif .... End If aralığındaki tüm seçeneklerin gerçekleştiği bir örnek belge eklerseniz daha hızlı sonuca ulaşılabilir.
.
 
Ömer BARAN' Alıntı:
Sorunun kaynağı tarih ile ilgili olabilir.
İsterseniz ilgili kısmı aşağıdaki değiştirerek deneyin.

Sonuç alamazsanız; If .... Elseif .... End If aralığındaki tüm seçeneklerin gerçekleştiği bir örnek belge eklerseniz daha hızlı sonuca ulaşılabilir.
.
Genişletmek için tıkla ...
ElseIf gt.Cells(a, "E") = "İlanda" And CDbl((gt.Cells(a, "N").Value)) < CDbl(Date) Then
DateValue kaldırınca çözüldü. teşekkürler. txt dosyasının kaydedilerek açık kalması durumuna bir şey yapabiliyor muyuz peki.
 
End Sub satırı ile Close #1 satırının arasına (MsgBox satırını eklemişseniz o satırdan sonra) aşağıdaki satırı da ekleyin.
CreateObject("Shell.Application").Open (ThisWorkbook.Path & "\Rapor.txt")
Genişletmek için tıkla ...
 
Epey birşey kaçırmışım galiba, neyse sanırım sorun hallolmuş. Yardımları için kıymetli adaşıma teşekkürler...
İyi çalışmalar...
 
Çözüm aslında Sayın adaşımın 4 numaralı cevabıyla tamamlanmış durumda idi.
Benim yaptığım, konu sahibinin yeni isteğine yönelik iki küçük ilaveden ibaret.

Önemli olan ihtiyacın karşılanması.
Kolay gelsin.
.
 
uzun zaman sonra bir ekleme yapma ihtiyacı duydum. kodun son halini aşağıda vereceğim, buna istinaden de sorumu sormak isterim. eğer ki oluşan txt dosyası boşsa yani tüm koşullar uygunsa "hata yok" şeklinde mesaj verebilir mi? dolayısı ile rapor.txt dosyasını da oluşturmasına gerek olmayacak.
Kod: 
Sub Rapor()
Set gt = Sheets("gt")
Open ThisWorkbook.Path & "\Rapor.txt" For Output As #1
For a = 3 To gt.Cells(Rows.Count, "g").End(3).Row
    If Round(gt.Cells(a, "X") - Round((gt.Cells(a, "Z") + gt.Cells(a, "AE") + gt.Cells(a, "AM")), 3), 3) < 0 Then
        Print #1, "Hedeften Dolayı, PB Sorgulanmalı, Proje Bedeli Aşıldı...", "Satır no: " & a
      
    ElseIf Round(gt.Cells(a, "X") - (gt.Cells(a, "Z") + gt.Cells(a, "AE") + gt.Cells(a, "AT")), 3) < 0 Then
        Print #1, "İmalattan dolayı, PB Sorgulanmalı, Proje Bedeli Aşıldı...", "Satır no: " & a

        
    ElseIf Round(gt.Cells(a, "X") - (gt.Cells(a, "AA") + gt.Cells(a, "AS")), 3) < 0 Then
        Print #1, "Borç ya da Harcamadan Dolayı, PB Sorgulanmalı, Proje Bedeli Aşıldı...", "Satır no: " & a

              
    ElseIf gt.Cells(a, "E") = "Tamamlandı" And gt.Cells(a, "X") - (gt.Cells(a, "AA") + gt.Cells(a, "AS")) > 0 Then
        Print #1, "Kesin Hesap Tamamlanmış fakat - PB uyumlu değil, Proje Bedeli Eşitlenmeli", "Satır no: " & a
      
    ElseIf gt.Cells(a, "X") - gt.Cells(a, "AA") < 0 Then
        Print #1, "Kümülatif Harcama PB'yi Geçmiş. Fiziki Gerçekleşme %100 ü aşmış", "Satır no: " & a
        
    ElseIf gt.Cells(a, "r") < gt.Cells(a, "s") Then
        Print #1, "SBF harcanan Toplam İhale Bedelinden Fazla", "Satır no: " & a
          
    ElseIf gt.Cells(a, "E") = "İlanda" And CDbl((gt.Cells(a, "N").Value)) < CDbl(Date) Then
        Print #1, "İhalesi yapılıp, işlenmeyenler var", "Satır no: " & a
    End If
Next
secim = MsgBox("RAPORU GÖRMEK İSTER MİSİN?", vbYesNo + vbExclamation, "HATA RAPORU OLUŞTURULDU!!!...")
If secim = vbYes Then
CreateObject("Shell.Application").Open (ThisWorkbook.Path & "\Rapor.txt")
ElseIf secim = vbNo Then
End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst