InputBox'la girilecek veriyi sınırlandırma

[Arthassss]

İnputbox'la veri dorulama ile sınırlandırışmış bir hücreye, sınırlandırmaya uygun olmayan değerler girilebilmekte. Bunu önlemenin yada İnputbox'a belirlenen değerler dışında rakam girmeyi engellemenin bir yolu varmıdır.
Farklı bir çözümde olabilir.
Örnek dosya ektedir.

 

[Recep İpek]

Aşağıdaki kodları deneyebilirmisiniz?

Private Sub CommandButton1_Click()
basla:
Application.ScreenUpdating = False
Range("a3").Select
            With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$C$1:$d$1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "UYARI"
        .InputMessage = ""
        .ErrorMessage = "BELİRLENEN DEĞERLER DIŞINDA VERİ GİRİŞİ YAPMAYINIZ"
        .ShowInput = True
        .ShowError = True
    End With
veri = InputBox("TABLO:1" & Chr(10) & " " & Chr(10) & "KONUT :2:")
If veri = Empty Then Exit Sub
If veri <> 1 And veri <> 2 Then
MsgBox "Yanlış Değer Girdiniz!", vbCritical, "Uyarı"
GoTo basla
End If
[a3] = veri
Range("A1").Select
End Sub

 

[Arthassss]

Sn. İpek teşekkür ederim.
Bunu daha fazla sayıya adapte edebilmek içinde
"If veri <> 1 And veri <> 2 And veri <> 3 Then" buraya rakamları bu şekilde girmemiz yeterli olur sanırsam.
Saygılar....

 

[Recep İpek]

Olması lazım...

 

[Arthassss]

Sn.İpek bu formüle birde hücre boşken inputbox' un boş geçilememesini yada boş geçilirse istediğim değeri eklemesini sağlayabilirmiyiz. Yani kısacası hücre hiç bir şekilde boş bırakılamasın.

 

[Recep İpek]

Kodları aşağıdaki şekilde değiştirerek deneyiniz.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Range("a3").Select
            With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$C$1:$d$1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "UYARI"
        .InputMessage = ""
        .ErrorMessage = "BELİRLENEN DEĞERLER DIŞINDA VERİ GİRİŞİ YAPMAYINIZ"
        .ShowInput = True
        .ShowError = True
    End With
basla:
veri = InputBox("TABLO:1" & Chr(10) & " " & Chr(10) & "KONUT :2:")
If veri = 1 Or veri = 2 Then
[a3] = veri
Else
MsgBox "Yanlış Değer Girdiniz!", vbCritical, "Uyarı"
GoTo basla
End If
Range("A1").Select
End Sub

 

[Arthassss]

Sn.İpek
Alakanız için tekrar çok teşekkür ederim.