Veri Doğrulama (Giriş İletisi) otomatik

[cllgny]

Merhaba değerli arkadaşlar,

1-herhangi bir hücre içindeki verileri, Veri Doğrulama - Giriş İletisine taşıma istiyorum. Yani A2 Hücresi içinde ne varsa, Giriş İletisi göstersin istiyorum. Bunu tek tek yapmak çok uzayacak, kolay bir yolu var mı, bayağı bir hücre var..

2- Yine A2 hücresine daha sonra ekleyeceğim başka bir şeyin, Giriş İletisine otomatik gitmesi için Makro lazım sanırım.
yardımlarınız için teşekkür ederim. saygılar..

 

[asi_kral]

Merhaba
Bence bu link işinizi görecektir

https://www.excel.web.tr/threads/veri-dogrulama-liste-uygulamasi-2-resimli-anlatim.108731/

 

[uzmanamele]

Merhaba

Bu kodu deneyiniz.

Sub İleti_Metni()
On Error Resume Next
    Cells(i, "A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "A").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

 

[cllgny]

Merhaba

Bu kodu deneyiniz.

Sub İleti_Metni()
On Error Resume Next
    Cells(i, "A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "A").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Değerli üstad, bu makro maalesef olmadı, bunu ekledikten sonra hiç bir hücrede Giriş iletileri de gelmemeye başladı. en sonda ki Nexk döngüsü de hata veriyor.

 

[cllgny]

Merhaba
Bence bu link işinizi görecektir

https://www.excel.web.tr/threads/veri-dogrulama-liste-uygulamasi-2-resimli-anlatim.108731/

Bu link çok eski sürüm exceller için ve işime yaramadı. ilginize teşekkür ederim..

 

[uzmanamele]

Merhaba

Nasıl olmuşsa bir satır silinmiş.

Sub İleti_Metni()
On Error Resume Next
For i = 1 To Range("A1048576").End(3).Row
    Cells(i, "A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "A").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

 

[cllgny]

Merhaba

Nasıl olmuşsa bir satır silinmiş.

Sub İleti_Metni()
On Error Resume Next
For i = 1 To Range("A1048576").End(3).Row
    Cells(i, "A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "A").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Değerli hocam mükemmel çalışıyor. emeğinize sağlık.

-Veri İleti bilgi ekran genişliği, içinde ki satır kadar olabiliyor mu, bu iletileri başka kaynaktan veya hücreden, alıp istediğimiz hücrede gösterme gibi bir şansımız var mı?
Teşekkür ederim...

 

[Korhan Ayhan]

Merhaba,

Döngü kullanmadan da yapılabilir.

Bold bölümler çıkmasını istediğiniz mesajın olduğu hücre adresidir.

Dilerseniz mouse ile hücre seçip uygulayabilirsiniz.

Option Explicit

Sub Secili_Alana_Uyari_Mesaji_Ekle()
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = Range("A1").Value
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Dilerseniz hücre adresi tanımlayabilirsiniz.

Option Explicit

Sub Hucre_Araligina_Uyari_Mesaji_Ekle()
    With Range("A10:K20").Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = Range("A1").Value
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

 

[cllgny]

Merhaba,

Döngü kullanmadan da yapılabilir.

Bold bölümler çıkmasını istediğiniz mesajın olduğu hücre adresidir.

Dilerseniz mouse ile hücre seçip uygulayabilirsiniz.

Option Explicit

Sub Secili_Alana_Uyari_Mesaji_Ekle()
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = Range("A1").Value
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Dilerseniz hücre adresi tanımlayabilirsiniz.

Option Explicit

Sub Hucre_Araligina_Uyari_Mesaji_Ekle()
    With Range("A10:K20").Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = Range("A1").Value
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Değerli hocam, Bu sadece A1 hücresini gösteriyor. ilk verdiğiniz makroda V sütunu hücrelerinde hepsi olmuştu. Şimdi şunu istiyorum, ilk formüldeki döngü gibi V sütunu hücreleri U hücrelerinde gösterilebilir mi?

 

[cllgny]

Sub İleti_Metni()
On Error Resume Next
For i = 1 To Range("V104").End(3).Row
    Cells(i, "u").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "v").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Değerli hocam sayenizde kodu bu şekilde yapınca tam istediğim gibi oldu. eksik veya hata var mı acaba? ellleriniz dert görmesin.

 

[Korhan Ayhan]

Ben ilk mesajınızda A2 diye belirtince tek hücredeki uyarıyı başka bir alanda görüntülemek istediğinizi düşündüm.

Eğer her hücre kendi satırında işleme alınacaksa #6 nolu mesajdaki kodu kullanmanız uygun olacaktır.

Son mesajınıza göre aşağıdaki kodu deneyebilirsiniz.

Option Explicit

Sub Hucre_Araligina_Uyari_Mesaji_Ekle()
    Dim Veri As Range
    
    Range("U:U").Validation.Delete
    
    For Each Veri In Range("V1:V" & Cells(Rows.Count, "V").End(3).Row)
        With Veri.Offset(, -1).Validation
            .Delete
            .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
            .InputMessage = Veri.Value
            .ShowInput = True
        End With
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cllgny]

Ben ilk mesajınızda A2 diye belirtince tek hücredeki uyarıyı başka bir alanda görüntülemek istediğinizi düşündüm.

Eğer her hücre kendi satırında işleme alınacaksa #6 nolu mesajdaki kodu kullanmanız uygun olacaktır.

Son mesajınıza göre aşağıdaki kodu deneyebilirsiniz.

Option Explicit

Sub Hucre_Araligina_Uyari_Mesaji_Ekle()
    Dim Veri As Range
   
    Range("U:U").Validation.Delete
   
    For Each Veri In Range("V1:V" & Cells(Rows.Count, "V").End(3).Row)
        With Veri.Offset(, -1).Validation
            .Delete
            .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
            .InputMessage = Veri.Value
            .ShowInput = True
        End With
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Hocam çok işe yaradı, şöyle bir sorun var, V sütunu U hücrelerinde gösteriyor (Bu tamam) ancak T sütunuda V hücrelerinde gösteriyor bu önceki makroları deneme-yanılma için sildim diye mi kaldı acaba?

 

[Korhan Ayhan]

Olabilir..

 

[cllgny]

Olabilir..

O geçersiz sütunlarda veri doğrulamadan tümünü sil yapınca hepsi düzeldi. Çok teşekkürler.

 

[uzmanamele]

Sub İleti_Metni()
On Error Resume Next
For i = 1 To Range("V104").End(3).Row
    Cells(i, "u").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "v").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Değerli hocam sayenizde kodu bu şekilde yapınca tam istediğim gibi oldu. eksik veya hata var mı acaba? ellleriniz dert görmesin.

Merhaba

Bu satırı revize edin, ilerde hatalı sonuç almazsınız.

For i = 1 To Range("V1048576").End(3).Row

 

[uzmanamele]

Merhaba

Sayfada kalmış olan başka girdi iletileri varsa temizleyip yeniden yazmak için bunu kullanabilirsiniz.

Sub İleti_Metni()
On Error Resume Next
Cells.Select
    With Selection.Validation
        .Delete
        .InputMessage = ""
    End With
For i = 1 To Range("V1048576").End(3).Row
    Cells(i, "U").Select
    With Selection.Validation
        .Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = Cells(i, "V").Text
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

 

[cllgny]

Merhaba

Bu satırı revize edin, ilerde hatalı sonuç almazsınız.

For i = 1 To Range("V1048576").End(3).Row

Bu yazdığınız revize öncesi 26 satır gösteriyordu; şimdi tüm satırlara ileti geldi. harika oldu.
Bu ileti kutucuğunun koordinat ve boyutları için bir ayar var mı acaba?
Çok teşekkür ederim..

Sub İleti_Metni()
On Error Resume Next
For i = 1 To Range("V1048576").End(3).Row
    Cells(i, "u").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .InputMessage = Cells(i, "v").Text
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

 

[uzmanamele]

Merhaba

Bunu deneyiniz.

Girdi ileti kutusunu fare ile yer değiştirirseniz hep o konumda açılır.

Sub İleti_Metni()
On Error Resume Next
Cells.Select
    With Selection.Validation
        .Delete
        .InputMessage = ""
    End With
For i = 1 To Range("V1048576").End(3).Row
    Cells(i, "U").Select
    With Selection.Validation
        .Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "" & Chr(10) & Cells(i, "V").Text & Chr(10) & "."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

 

[cllgny]

Merhaba

Bunu deneyiniz.

Girdi ileti kutusunu fare ile yer değiştirirseniz hep o konumda açılır.

Sub İleti_Metni()
On Error Resume Next
Cells.Select
    With Selection.Validation
        .Delete
        .InputMessage = ""
    End With
For i = 1 To Range("V1048576").End(3).Row
    Cells(i, "U").Select
    With Selection.Validation
        .Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "" & Chr(10) & Cells(i, "V").Text & Chr(10) & "."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Hocam o ellerin dert görmesin. çok güzel oldu. Koordinat da tamam. ama bundan önceki kodda kutucuk içinde ki 1. satır BOLD karakterdi. o kayboldu.

 

[cllgny]

Merhaba

Bunu deneyiniz.

Girdi ileti kutusunu fare ile yer değiştirirseniz hep o konumda açılır.

Sub İleti_Metni()
On Error Resume Next
Cells.Select
    With Selection.Validation
        .Delete
        .InputMessage = ""
    End With
For i = 1 To Range("V1048576").End(3).Row
    Cells(i, "U").Select
    With Selection.Validation
        .Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "" & Chr(10) & Cells(i, "V").Text & Chr(10) & "."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Next
End Sub

Hocam hücreye veriyi giriyorum ancak iletiyi hemen güncellemiyor. sayfa yeniden açılınca mı yeniliyor. Ben makroyu durudurup yeniden çalıştırınca yeniledi. başka şekil güncelleme olmuyor.