Soru aynı numaraları kıyaslama

[incsoft]

Sayfamda aynı numaradan 2 tane kullanmak istemiyorum. Bununla ilgili sorum ektedir. Nasıl bir yöntem olabilir? Macro harici olursa iyi olur arkadaşlar. Kullanacak kişilerin fazla bilgisi olmadığından girdikten sonra her seferinde macro çalıştıramazlar..

Teşekkürler...

 

[Muzaffer Ali]

Merhaba.

Veri / Veri Doğrulama / Veri Doğrulama seçin
İzin Önerilen=Özel seçin
Formül Kısmına =EĞERSAY($A$1:$C$13;A1)=1 formülünü kopyalayın.
Hata Uyarısı tabını açın 'Hata İletisi' kısmına istediğiniz uyarı metnini yazın.
Örnek: "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz."
Tamamı tıklatın.

 

[incsoft]

Merhaba.

Veri / Veri Doğrulama / Veri Doğrulama seçin
İzin Önerilen=Özel seçin
Formül Kısmına =EĞERSAY($A$1:$C$13;A1)=1 formülünü kopyalayın.
Hata Uyarısı tabını açın 'Hata İletisi' kısmına istediğiniz uyarı metnini yazın.
Örnek: "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz."
Tamamı tıklatın.

=EĞERSAY($F$20:$F$30;$U$20:$V$30;$AM$20:$AN$30;$F$51:$F$61;$U$51:$V$61;$AM$51:$AN$61;$F$20)=1

Hücrelerim sayfamda bu şekilde onuda kabul etmiyor hocam.

 

[incsoft]

Merhaba.

Veri / Veri Doğrulama / Veri Doğrulama seçin
İzin Önerilen=Özel seçin
Formül Kısmına =EĞERSAY($A$1:$C$13;A1)=1 formülünü kopyalayın.
Hata Uyarısı tabını açın 'Hata İletisi' kısmına istediğiniz uyarı metnini yazın.
Örnek: "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz."
Tamamı tıklatın.

 

[Muzaffer Ali]

O zaman şöyle yapmalısınız

=(EĞERSAY($F$20:$F$30;A1)+EĞERSAY($U$20:$V$30;A1))=1

Yani her birleşik alanı ayrı ayrı "eğersay" formülü ile saydırıp toplamalısınız.

 

[incsoft]

O zaman şöyle yapmalısınız

=(EĞERSAY($F$20:$F$30;A1)+EĞERSAY($U$20:$V$30;A1))=1

Yani her birleşik alanı ayrı ayrı "eğersay" formülü ile saydırıp toplamalısınız.

Burda bütün alanlar seçilerekmi istenilen formül girilmeli hocam?

=(EĞERSAY($F$20:$F$30;A1)+EĞERSAY($U$20:$V$30;A1)+EĞERSAY($AM$20:$AN$30;A1)+EĞERSAY($F$51:$F$61;A1)+EĞERSAY($U$51:$V$61;A1)+EĞERSAY($AM$51:$AN$61;A1)=1)

Bu şeklie getirdim ancak şimdide neyi girersem var diyor ). A1 olan A2,A3,A4....A100 şeklinde değişmelimi?

 

[Muzaffer Ali]

Mümkünse dosyanızı ekleyin kontrol edeyim.
Özel bilgiler varsa bir kopyasını alıp özel bilgileri silerek ekleyin.

Bir şey daha sorayım, bir rakam yazıldığında yukarıda yazdığınız tüm alanlarda sadece bir tane mi olması gerekiyor yoksa her alan kendi içinde mi kontrol edilecek?

 

[incsoft]

Mümkünse dosyanızı ekleyin kontrol edeyim.
Özel bilgiler varsa bir kopyasını alıp özel bilgileri silerek ekleyin.

Bir şey daha sorayım, bir rakam yazıldığında yukarıda yazdığınız tüm alanlarda sadece bir tane mi olması gerekiyor yoksa her alan kendi içinde mi kontrol edilecek?

Tüm alanlarda 1 tane olacak hocam. Yeşil ile eklediğim kısımlara sadece aynı numaradan 1 tane yazılabilecek.

Teşekkürler.

 

[Muzaffer Ali]

Sanıyorum bunu veri doğrulama ile çözemeyeceğiz.
Ama isterseniz kod ile olur.
Aşağıdaki kodu sayfanın kod kısmına kopyalayın.
Bu kodlar sayfanın en üstünde olmalı.

Dim OncekiHucre As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range
    Dim Bak As Range
    Set Alan = Range("F20:F30,F51:F61,U20:U30,U51:U61,AM20:AM30,AM51:AM61")
    If Not Intersect(Alan, Target) Is Nothing Then
        For Each Bak In Alan
            If Bak = Target And Bak.Address <> Target.Address Then
                Target.Select
                Set OncekiHucre = Target
                Exit For
            Else
                OncekiHucre = Nothing
            End If
        Next
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not OncekiHucre Is Nothing Then
        Application.EnableEvents = False
        OncekiHucre.Select
        MsgBox "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz.", vbCritical, "Hata"
        Application.EnableEvents = True
    End If
End Sub

 

[incsoft]

Sanıyorum bunu veri doğrulama ile çözemeyeceğiz.
Ama isterseniz kod ile olur.
Aşağıdaki kodu sayfanın kod kısmına kopyalayın.
Bu kodlar sayfanın en üstünde olmalı.

Dim OncekiHucre As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range
    Dim Bak As Range
    Set Alan = Range("F20:F30,F51:F61,U20:U30,U51:U61,AM20:AM30,AM51:AM61")
    If Not Intersect(Alan, Target) Is Nothing Then
        For Each Bak In Alan
            If Bak = Target Then
                Target.Select
                Set OncekiHucre = Target
                Exit For
            Else
                OncekiHucre = Nothing
            End If
        Next
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not OncekiHucre Is Nothing Then
        Application.EnableEvents = False
        OncekiHucre.Select
        MsgBox "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz.", vbCritical, "Hata"
        Application.EnableEvents = True
    End If
End Sub

Hocam destekleriniz için öncelikle teşekkür ederim. Visual Basic den hangi alana eklediysem uyarı vermeden direk girdi. Size zahmet dosyaya ekleyip atma şansınız varmıdır?

Her yeri denedim. Module1,2,3 , ThisWorkbook Sayfaların bulunduğu yerler....

 

[incsoft]

boş sayfada oldu ama ne yazarsam var diyor

 

[Muzaffer Ali]

Dosya ekte.
Kodda hata varmış düzelttim.

 

[incsoft]

Aynısı varken buluyor silince bu hatayı veriyor bu nedendir acaba hocam? Bu da çözülürse çok güzel.

 

[Muzaffer Ali]

Önceki kodları silip aşağıdakileri kopayalayıp dener misiniz?

Dim OncekiHucre As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range
    Dim Bak As Range
    Set Alan = Range("F20:F30,F51:F61,U20:U30,U51:U61,AM20:AM30,AM51:AM61")
    If Not Intersect(Alan, Target) Is Nothing Then
        For Each Bak In Alan
            If Target.Text = "" Or Bak = Target And Bak.Address <> Target.Address Then
                Set OncekiHucre = Target
                Exit For
            Else
                Set OncekiHucre = Nothing
            End If
        Next
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not OncekiHucre Is Nothing Then
        If Not OncekiHucre.Text = "" Then
            Application.EnableEvents = False
            OncekiHucre.Select
            MsgBox "Aynı rakamdan iki tane olamaz, lütfen kontrol ederek tekrar deneyiniz.", vbCritical, "Hata"
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[incsoft]

Aynı hocam

 

[Muzaffer Ali]

Tam olarak ne yapınca orada hata veriyor?
Her türlü deneme yaptım hata almadım.