40 ayrı koşul için validatelist

[peleryn]

Herkese Merhabalar;

Sayfanın D9:I192 aralığına 40 ayrı koşul için adları tanımlanmış 40 ayrı listeyi her biri uygun hücreye konuşlanacak şekilde yerleştirmem için kullanmam gereken döngü kalıbını öğrenmeye ihtiyacım var."salibir" ve "cumaiki" adları için bu kalıbı nasıl oluşturabiliriz yardımcı olan olursa çok sevinirim.

"salibir" için koşul : ilgili satırda 11.hücre "SALI" 12. hücre "09:00" ise
"cumaiki" için koşul : ilgili satırda 11.hücre "CUMA" 12. hücre "10:00" ise

İlgilenen herkese şimdiden çok teşekkür ederim.

 

[peleryn]

NOT:Bu kodları bir modül içine yerleştirip bir butona atayacağım ve her ayın başında butona 1 kere basıp her hücredeki listenin o aya ait koşullara uyan şekilde değişmesini sağlayacağım ve aralıktaki tüm hücrelere sağladığı koşula göre mutlaka bir liste yerleşmiş olacak.

 

[peleryn]

Kodu Worksheet activate olayında deneyerek yazmaya çalışıyorum ama aşağıda vereceğim kodlarda hata alıyorum bir yardımcı olan olsa aşıcam.Umarım ilgilenen birisi çıkar.

Private Sub Worksheet_Activate()
Dim hcr As Range
gun = Cells(hcr.Row, 11).Value
saat = Cells(hcr.Row, 12).Value
For Each hcr In Range("d9:ı192")
If gun = "SALI" And saat = "09:00 09:45" Then
With hcr.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=salibir"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
Next
End Sub

Object variable or with block variable not set ..hata mesajını veriyor.

 

[peleryn]

merhabalar konuyla ilgilenen varsa sorunumu hallettim buradan cevap gelmese de bugüne kadar buradan edindiklerim sayesinde sorunu hallettim dosyalarımda emeği olan herkese teşekkür ediyorum.

 

[parametre]

bilmeyen kişiler için sorununun cozumunude verki senin gibi ogrensinler

 

[peleryn]

Sn parametre çok haklısınız.Genelde bu tarz şeylere özen gösteriyorum ancak bugün yoğunluktan es geçmek durumunda kaldım.

Çok bir değişiklik yok.değişken tanımlamalarını kaldırdım ve istediğim koşul sayısınca If'leri çoğalttım.

Sub liste()
Dim hcr As Range
For Each hcr In Range("D9:I192")
If Cells(hcr.Row, 11).Value = "SALI" And Cells(hcr.Row, 12).Value = "09:00 09:45" Then
With hcr.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=salibir"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
Next
End Sub