Çoklu Veri Doğrulama

[baydeniro]

Merhaba Arkadaşlar,
Aynı hücrede 1den fazla verinin listede olup olmadığının VERİ DOĞRULAMA formatında kontrolü mümkün mü ?

 

[Muzaffer Ali]

Merhaba.
Satış adlı sayfa adını sağ tıklatın Kod Görüntüle seçin açılan sayfaya aşağıdaki kodu kopyalayın.
Burada dikkat etmeniz gereken şey Satış Fişi alanına girdiğiniz ürün isimlerinin arasında mutlaka ";" işareti olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Urun 'as String
    Dim Bak As Integer
    Dim Bul As Range
    If Not Intersect(Target, Range("A:A")) Is Nothing And Target <> "" Then
        Urun = Split(Target, ";")
        For Bak = 0 To UBound(Urun)
            Set Bul = Worksheets("ÜRÜN").Range("A:A").Find(what:=Urun(Bak), LookAt:=xlWhole)
            If Bul Is Nothing Then
                MsgBox "Ürün listesinde '" & Urun(Bak) & "' yok. Lütfen kontrol ederek yeniden deneyiniz.", vbExclamation
                Target.Select
                Exit Sub
            End If
        Next
    End If
End Sub

 

[Ömer]

Merhaba,

Veri doğrulama ile alternatif.

A2:A4 aralığı > veri doğrulama > özel den formül bölümüne;

=TOPLA(EĞERSAY(ÜRÜN!$A$2:$A$100;KIRP(PARÇAAL(YERİNEKOY(A2;";";YİNELE(" ";UZUNLUK(A2)));(SATIR(DOLAYLI("1:"&1+UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;";";""))))-1)*UZUNLUK(A2)+1;UZUNLUK(A2)))))=1+UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;";";""))

Not: Tam eşleştirme olarak arar. Örneğinizde satış sayfası A3: "Patatesi;Kavun" buradaki patatesi ürün sayfasında Patates olarak geçtiği için girişine izin vermez.

Ürün bire bir arandığı için ben bu şekilde algıladım.

 

[baydeniro]

Merhaba.
Satış adlı sayfa adını sağ tıklatın Kod Görüntüle seçin açılan sayfaya aşağıdaki kodu kopyalayın.
Burada dikkat etmeniz gereken şey Satış Fişi alanına girdiğiniz ürün isimlerinin arasında mutlaka ";" işareti olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Urun 'as String
    Dim Bak As Integer
    Dim Bul As Range
    If Not Intersect(Target, Range("A:A")) Is Nothing And Target <> "" Then
        Urun = Split(Target, ";")
        For Bak = 0 To UBound(Urun)
            Set Bul = Worksheets("ÜRÜN").Range("A:A").Find(what:=Urun(Bak), LookAt:=xlWhole)
            If Bul Is Nothing Then
                MsgBox "Ürün listesinde '" & Urun(Bak) & "' yok. Lütfen kontrol ederek yeniden deneyiniz.", vbExclamation
                Target.Select
                Exit Sub
            End If
        Next
    End If
End Sub

Üstad elinize aklınız sağlık, çok mükemmel bir kod. Sağ olun, var olun, sağlıcakla kalın

 

[baydeniro]

Merhaba,

Veri doğrulama ile alternatif.

A2:A4 aralığı > veri doğrulama > özel den formül bölümüne;

=TOPLA(EĞERSAY(ÜRÜN!$A$2:$A$100;KIRP(PARÇAAL(YERİNEKOY(A2;";";YİNELE(" ";UZUNLUK(A2)));(SATIR(DOLAYLI("1:"&1+UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;";";""))))-1)*UZUNLUK(A2)+1;UZUNLUK(A2)))))=1+UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;";";""))

Not: Tam eşleştirme olarak arar. Örneğinizde satış sayfası A3: "Patatesi;Kavun" buradaki patatesi ürün sayfasında Patates olarak geçtiği için girişine izin vermez.

Ürün bire bir arandığı için ben bu şekilde algıladım.

Üstad elinize aklınız sağlık, formül uzun olunca biraz endişelendim ama harika çalışıyor. Sağ olun, var olun, sağlıcakla kalın