Şarta bağlı uyarı mesajı aldırmak..

[EKREM1661]

Değerli Arkadaşlar.. Aşağıdaki kod; H ve I sütunlarındaki tarih aralıklarını tabloya harf olarak yansıtıyor..
Ancak yansıttığı harfi, solundaki (G sütunu) hücreden alıyor..
Fakat, eğer her hangi bir tarihin (G sütunundaki) karşılığı boş ise uyarı versin.
Bu tanımı nasıl, kod'a ilave edebiliriz?

Sub izinleriTabloyaYerleştir()
Application.ScreenUpdating = False
On Error Resume Next
For i = 5 To Range("g65536").End(xlUp).Row
If Cells(i, "g") <> "" And Cells(i, "h") <> "" And Cells(i, "ı") <> "" Then
For k = 11 To 490
tarr = Cells(4, k)
If tarr >= Cells(i, "h") And tarr <= Cells(i, "ı") Then
Cells(i, k) = Cells(i, "g")
say = say + 1
End If
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox say & " Adet İzin işlendi.", vbInformation
End Sub

 

[kulomer46]

Merhaba

Aşağıdaki kod satırı eklenebilir.

if trim(Cells(i, "g")) = "" then msgbox i & ". Satırda G" & i & " Hücresinde Veri Bulunmamaktadır."

Bu kod satırı kodlarınızda 4. satırdan sonra yeni boş satır açılarak eklenmiştir.

Selamlar...

Sub izinleriTabloyaYerleştir()
Application.ScreenUpdating = False
On Error Resume Next
For i = 5 To Range("g65536").End(xlUp).Row

if  trim(Cells(i, "g")) = "" then msgbox  i  &  ". Satırda  G"  & i & "  Hücresinde Veri Bulunmamaktadır."

If Cells(i, "g") <> "" And Cells(i, "h") <> "" And Cells(i, "ı") <> "" Then
For k = 11 To 490
tarr = Cells(4, k)
If tarr >= Cells(i, "h") And tarr <= Cells(i, "ı") Then
Cells(i, k) = Cells(i, "g")
say = say + 1
End If
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox say & " Adet İzin işlendi.", vbInformation
End Sub

 

[EKREM1661]

Hocam, mesaj için gereken şartlar olsa da çalışıyor, olmasa da..
Sorun yoksa, mesajı atlasın/yok saysın..
H-I-G sütunları, (5-124 satır aralığında) her hangi hücresinde veri olur da karşılığı olmaz ise,
ve bir de B3 hücresi boş ise, uyarı mesajı versin..
Kolay anlaşılması için, açıklamasıyla birlikte örnek dosyayı ekliyorum..

 

[kulomer46]

Merhaba

düzenliyorum..

 

[kulomer46]

Merhaba

İlk kodlarınıza aşağıdaki koyu renkli kodu ekleyiniz.

Selamlar...

Sub izinleriTabloyaYerleştir()

Application.ScreenUpdating = False
On Error Resume Next

For i = 5 To Range("g65536").End(xlUp).Row

if trim(Cells(i, "g")) = "" And Cells(i, "h") <> "" And Cells(i, "ı") <> "" and len(trim(Cells(3,2)))>0 Then msgbox i & ". Satırda G" & i & " Hücresinde Veri Bulunmamaktadır."

If Cells(i, "g") <> "" And Cells(i, "h") <> "" And Cells(i, "ı") <> "" Then
For k = 11 To 490
tarr = Cells(4, k)
If tarr >= Cells(i, "h") And tarr <= Cells(i, "ı") Then
Cells(i, k) = Cells(i, "g")
say = say + 1
End If
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox say & " Adet İzin işlendi.", vbInformation

End Sub

 

[EKREM1661]

Hocam, öncelikle çok çok teşekkürler, istediğim oldu.. Asıl gözden kaçan G sütunu idi o halledildi.
Acaba; G sütununda eksiklik/seçilmemiş kısım olması halinde, kod'u "Exit Sub" yaptırabilir miyiz? (eksikliği giderme zorunluluğu oluşsun diye)

Birde uygulamada bakınca fark ettim.. B3 şartı "x doldurmak" için (commandbutton3) için gerekliydi, karıştırmışım özür dilerim.
Bunun için "and len(trim(Cells(3,2)))>0" kısmını diğer kod için nasıl yazayım?

 

[kulomer46]

Hocam, öncelikle çok çok teşekkürler, istediğim oldu.. Asıl gözden kaçan G sütunu idi o halledildi.
Acaba; G sütununda eksiklik/seçilmemiş kısım olması halinde, kod'u "Exit Sub" yaptırabilir miyiz? (eksikliği giderme zorunluluğu oluşsun diye)

Birde uygulamada bakınca fark ettim.. B3 şartı "x doldurmak" için (commandbutton3) için gerekliydi, karıştırmışım özür dilerim.
Bunun için "and len(trim(Cells(3,2)))>0" kısmını diğer kod için nasıl yazayım?

Merhaba

Dosyanız Hazır.
Tüm talepleriniz halledildi gibi duruyor.

Selamlar...

 

[EKREM1661]

Üstad.. çok makbule geçti, (hatalı yeri renklendirme de yapıyor) ziyadesiyle teşekkürler, ellerine sağlık.. Hayırlı ömürler diliyorum..

 

[kulomer46]

Üstad.. çok makbule geçti, (hatalı yeri renklendirme de yapıyor) ziyadesiyle teşekkürler, ellerine sağlık.. Hayırlı ömürler diliyorum..

Selamlar...

 

[EKREM1661]

kulomer46 hocam, konuya daha önce el attığın için yine size döndüm. Çözüm gerektiren son bir kısım kaldı, açıklamasını dosyada belirttim. Süzülen satırları ve kısmını tabloya aktarmakla ilgili.. Bakabilirseniz, çok memnun olurum. (İsterseniz yeni başlık mı açayım? konu biraz farklılaştı)