Çoklu Veri Doğrulama

johnwick5208 · 19 Mart 2019

Öncelikle Merhaba kullanmış olduğum internette filtre olduğu için dosya paylaşımı yapamıyorum. Excel tablosunda I2, J2, K2 sütunlardaki verileri bağlantılı şekilde veri doğrulama ile nasıl ilişklendirebilirim.

Örnek:
I1=Görev Unvanı(Müdür ya da Müdür Yardımcısı), J1= İlçesi K1= O İlçedeki şubeler
I2= Müdür unvanını seçtim ondan sonra J2=İlçeyi Seçtim sonra K2'ye tıkladığımda o ilçedeki müdür unvanı olan şubeleri nasıl listeyebilirim. Gerekli ad tanımlamaları yaptım. Veri doğrulama (Liste Yöntemi) ile nasıl yapabilirim? Umarım derdimi anlatabilmişimdir.

ÖmerBey · 19 Mart 2019

Merhaba,
Şuradaki konu sanırım işinizi görecektir.

çıtır · 19 Mart 2019

Örnek dosyadaki Liste sayfasını verilerinize göre düzenliyerek belki çözersiniz diye düşünüyorum.Dosya ektedir.
https://www.dosyaupload.com/al4p

johnwick5208 · 20 Mart 2019

Hocam gönderdiği formda örnek olarak müdür unvanını seçtim ondan sonra altındağ ilçesi seçince müdür unvanı olan mesela a şubesi b şubesi c şubesi listelenecek şekilde olanını yapabilir misin?

çıtır · 20 Mart 2019

johnwick5208' Alıntı:
Hocam gönderdiği formda örnek olarak müdür unvanını seçtim ondan sonra altındağ ilçesi seçince müdür unvanı olan mesela a şubesi b şubesi c şubesi listelenecek şekilde olanını yapabilir misin?

Altındağ ilçesinin karşısına Müdür altına a şubesi,b şubesi, c şubesi yazınız.Ben müdür1...müdür15 yazdım siz bilgileriniz le değiştiriniz verileri.Sayfa2 de değişiklik çıkar.Örnek dosyanız yok.Başka nasıl çözüm olur bilmiyorum.

johnwick5208 · 20 Mart 2019

çıtır' Alıntı:
Altındağ ilçesinin karşısına Müdür altına a şubesi,b şubesi, c şubesi yazınız.Ben müdür1...müdür15 yazdım siz bilgileriniz le değiştiriniz verileri.Sayfa2 de değişiklik çıkar.Örnek dosyanız yok.Başka nasıl çözüm olur bilmiyorum.

Peki hocam formülü yana kaydır şeklinde yaptınız ya onu alt alta sıralanmış şekilde nasıl formülüze ederiz. Örnek A1 İle A10 satırlarında müdür veya müdür yardımcısı, B1 ile B10 satırlarında ilçeler, C1 ile C10 hücresinde ilçeye bağlı şube isimleri var. Mail Adresiniz varsa mail atabilirim.

çıtır · 20 Mart 2019

Aklıma gelen yöntem bu Tüm ilçeleri yazıp altınada şubeleri yazabilirsiniz.Hazırlanmış olan dosyanın kullana bilirsiniz , başka bir şekilde yardımcı olamam ilgi gösteren arkadaşlar yardımcı olur.

johnwick5208 · 20 Mart 2019

çıtır' Alıntı:
Aklıma gelen yöntem bu Tüm ilçeleri yazıp altınada şubeleri yazabilirsiniz.Hazırlanmış olan dosyanın kullana bilirsiniz , başka bir şekilde yardımcı olamam ilgi gösteren arkadaşlar yardımcı olur.

çok teşekkür ederim ilgi ve alakanız için

çıtır · 20 Mart 2019

johnwick5208' Alıntı:
çok teşekkür ederim ilgi ve alakanız için

Rica ederim.Dönüşünüz için teşekkür ederim.

Korhan Ayhan · 20 Mart 2019

Dosyanızı paylaşım sitelerine yükleyemiyor musunuz?

Eğer sıkıntınız devam ediyorsa profilimdeki (gmail) mail adresime dosyanızı gönderebilirsiniz.

johnwick5208 · 21 Mart 2019

Korhan Ayhan' Alıntı:
Dosyanızı paylaşım sitelerine yükleyemiyor musunuz?

Eğer sıkıntınız devam ediyorsa profilimdeki (gmail) mail adresime dosyanızı gönderebilirsiniz.

Profilinizde mail adresinizi bulamadım. buradan yazabilir misiniz Korhan bey size zahmet

Korhan Ayhan · 21 Mart 2019

Merhaba,

Aşağıdaki kodu "Tercih Listesi" isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_B As Object, Dizi_C As Object, Veri As Range, Son As Long
   
    Set Dizi_B = CreateObject("System.Collections.ArrayList")
    Set Dizi_C = CreateObject("System.Collections.ArrayList")
   
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
   
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Validation.Delete
            End If
        Next
    End If
   
    Select Case Target.Column
        Case 1
       
            Son = S2.Cells(Rows.Count, 2).End(3).Row
           
            For Each Veri In S2.Range("B3:B" & Son)
                If Veri.Offset(0, -1) = Cells(Target.Row, "A") Then
                    If Dizi_B.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                        Dizi_B.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                    End If
                End If
            Next
           
            Dizi_B.Sort
           
            With Range("B" & Target.Row)
                .Validation.Delete
                If Dizi_B.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_B.ToArray, ",")
            End With
       
        Case 2

            Son = S2.Cells(Rows.Count, 3).End(3).Row
           
            For Each Veri In S2.Range("C3:C" & Son)
                If Veri.Offset(0, -2) = Cells(Target.Row, "A") Then
                    If Veri.Offset(0, -1) = Cells(Target.Row, "B") Then
                        If Dizi_C.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                            Dizi_C.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                        End If
                    End If
                End If
            Next
           
            Dizi_C.Sort
           
            With Range("C" & Target.Row)
                .Validation.Delete
                If Dizi_C.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_C.ToArray, ",")
            End With
    End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_A As Object, Veri As Range, Son As Long
   
    Set Dizi_A = CreateObject("System.Collections.ArrayList")
   
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
   
    Son = S2.Cells(Rows.Count, 1).End(3).Row
   
    For Each Veri In S2.Range("A3:A" & Son)
        If Dizi_A.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
            Dizi_A.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
        End If
    Next
   
    Dizi_A.Sort
   
    With Range("A" & Target.Row)
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_A.ToArray, ",")
    End With
End Sub

johnwick5208 · 21 Mart 2019

Korhan Ayhan' Alıntı:

Merhaba,

Aşağıdaki kodu "Tercih Listesi" isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_B As Object, Dizi_C As Object, Veri As Range, Son As Long
  
    Set Dizi_B = CreateObject("System.Collections.ArrayList")
    Set Dizi_C = CreateObject("System.Collections.ArrayList")
  
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
  
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Validation.Delete
            End If
        Next
    End If
  
    Select Case Target.Column
        Case 1
      
            Son = S2.Cells(Rows.Count, 2).End(3).Row
          
            For Each Veri In S2.Range("B3:B" & Son)
                If Veri.Offset(0, -1) = Cells(Target.Row, "A") Then
                    If Dizi_B.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                        Dizi_B.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                    End If
                End If
            Next
          
            Dizi_B.Sort
          
            With Range("B" & Target.Row)
                .Validation.Delete
                If Dizi_B.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_B.ToArray, ",")
            End With
      
        Case 2

            Son = S2.Cells(Rows.Count, 3).End(3).Row
          
            For Each Veri In S2.Range("C3:C" & Son)
                If Veri.Offset(0, -2) = Cells(Target.Row, "A") Then
                    If Veri.Offset(0, -1) = Cells(Target.Row, "B") Then
                        If Dizi_C.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                            Dizi_C.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                        End If
                    End If
                End If
            Next
          
            Dizi_C.Sort
          
            With Range("C" & Target.Row)
                .Validation.Delete
                If Dizi_C.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_C.ToArray, ",")
            End With
    End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_A As Object, Veri As Range, Son As Long
  
    Set Dizi_A = CreateObject("System.Collections.ArrayList")
  
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
  
    Son = S2.Cells(Rows.Count, 1).End(3).Row
  
    For Each Veri In S2.Range("A3:A" & Son)
        If Dizi_A.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
            Dizi_A.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
        End If
    Next
  
    Dizi_A.Sort
  
    With Range("A" & Target.Row)
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_A.ToArray, ",")
    End With
End Sub

Gönderdiğiniz mail ekinde dosyayı açtım sadece ilçe kısmında ilçeler gözüküyor. İlçe seçtikten sonra unvan kısmında bir şey çıkmıyor.

johnwick5208 · 21 Mart 2019

Korhan Ayhan' Alıntı:

Merhaba,

Aşağıdaki kodu "Tercih Listesi" isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

Kod:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_B As Object, Dizi_C As Object, Veri As Range, Son As Long
  
    Set Dizi_B = CreateObject("System.Collections.ArrayList")
    Set Dizi_C = CreateObject("System.Collections.ArrayList")
  
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
  
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Validation.Delete
            End If
        Next
    End If
  
    Select Case Target.Column
        Case 1
      
            Son = S2.Cells(Rows.Count, 2).End(3).Row
          
            For Each Veri In S2.Range("B3:B" & Son)
                If Veri.Offset(0, -1) = Cells(Target.Row, "A") Then
                    If Dizi_B.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                        Dizi_B.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                    End If
                End If
            Next
          
            Dizi_B.Sort
          
            With Range("B" & Target.Row)
                .Validation.Delete
                If Dizi_B.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_B.ToArray, ",")
            End With
      
        Case 2

            Son = S2.Cells(Rows.Count, 3).End(3).Row
          
            For Each Veri In S2.Range("C3:C" & Son)
                If Veri.Offset(0, -2) = Cells(Target.Row, "A") Then
                    If Veri.Offset(0, -1) = Cells(Target.Row, "B") Then
                        If Dizi_C.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
                            Dizi_C.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                        End If
                    End If
                End If
            Next
          
            Dizi_C.Sort
          
            With Range("C" & Target.Row)
                .Validation.Delete
                If Dizi_C.Count > 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_C.ToArray, ",")
            End With
    End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Dizi_A As Object, Veri As Range, Son As Long
  
    Set Dizi_A = CreateObject("System.Collections.ArrayList")
  
    Set S1 = Sheets("Tercih Listesi")
    Set S2 = Sheets("Şube")
  
    Son = S2.Cells(Rows.Count, 1).End(3).Row
  
    For Each Veri In S2.Range("A3:A" & Son)
        If Dizi_A.Contains(UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))) = False Then
            Dizi_A.Add UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
        End If
    Next
  
    Dizi_A.Sort
  
    With Range("A" & Target.Row)
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi_A.ToArray, ",")
    End With
End Sub

Şu satırda hata veriyor Set Dizi_A = CreateObject("System.Collections.ArrayList")

Korhan Ayhan · 21 Mart 2019

Sisteminize güncel ".NET Framework" versiyonunu yükleyip deneyiniz.

johnwick5208 · 21 Mart 2019

Korhan Ayhan' Alıntı:
Sisteminize güncel ".NET Framework" versiyonunu yükleyip deneyiniz.

Yükledim ama hata veriyor yine Set Dizi_B = CreateObject("System.Collections.ArrayList") burayı gösteriyor hata olarak

Korhan Ayhan · 22 Mart 2019

Bu örnekte ADO kullanıldı.

Kod:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
    
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("B" & Veri.Row).Value = ""
                Range("C" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Value = ""
            End If
        Next
    End If
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
    "Data Source = " & ThisWorkbook.FullName & ";" & _
    "Extended Properties=""Excel 12.0;Hdr=No"""
    
    Set Kayit = Baglanti.Execute("Select Distinct F1 From [Şube$A3:A65536] Order By F1 Asc")
    
    If Not Kayit.EOF Then
        Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
        With Range("A" & Target.Row)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
        End With
    End If
    
    Set Kayit = Nothing
    Set Baglanti = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
    "Data Source = " & ThisWorkbook.FullName & ";" & _
    "Extended Properties=""Excel 12.0;Hdr=No"""
        
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("B" & Veri.Row).Value = ""
                Range("C" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Value = ""
            End If
        Next
    End If
    
    Select Case Target.Column
        Case 1

            Set Kayit = Baglanti.Execute("Select F3 From [Şube$] Where F1 = '" & Cells(Target.Row, 1) & "' Group By F3")
            
            If Not Kayit.EOF Then
                Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
                With Range("B" & Target.Row)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
                End With
            End If

        Case 2

            Set Kayit = Baglanti.Execute("Select F2 From [Şube$] Where F1 = '" & Cells(Target.Row, 1) & "' And F3 = '" & Cells(Target.Row, 2) & "' Group By F2")
            
            If Not Kayit.EOF Then
                Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
                With Range("C" & Target.Row)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
                End With
            End If
    End Select

    Set Kayit = Nothing
    Set Baglanti = Nothing
End Sub

johnwick5208 · 22 Mart 2019

Korhan Ayhan' Alıntı:

Bu örnekte ADO kullanıldı.

Kod:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
   
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("B" & Veri.Row).Value = ""
                Range("C" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Value = ""
            End If
        Next
    End If
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
    "Data Source = " & ThisWorkbook.FullName & ";" & _
    "Extended Properties=""Excel 12.0;Hdr=No"""
   
    Set Kayit = Baglanti.Execute("Select Distinct F1 From [Şube$A3:A65536] Order By F1 Asc")
   
    If Not Kayit.EOF Then
        Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
        With Range("A" & Target.Row)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
        End With
    End If
   
    Set Kayit = Nothing
    Set Baglanti = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Baglanti As Object, Kayit As Object, Dizi As Variant
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;" & _
    "Data Source = " & ThisWorkbook.FullName & ";" & _
    "Extended Properties=""Excel 12.0;Hdr=No"""
       
    If Target.Cells.Count > 1 Then
        For Each Veri In Selection
            If Cells(Veri.Row, "A") = "" Then
                Range("B" & Veri.Row).Validation.Delete
                Range("B" & Veri.Row).Value = ""
                Range("C" & Veri.Row).Validation.Delete
                Range("C" & Veri.Row).Value = ""
            End If
        Next
    End If
   
    Select Case Target.Column
        Case 1

            Set Kayit = Baglanti.Execute("Select F2 From [Şube$] Where F1 = '" & Cells(Target.Row, 1) & "' Group By F2")
           
            If Not Kayit.EOF Then
                Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
                With Range("B" & Target.Row)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
                End With
            End If

        Case 2

            Set Kayit = Baglanti.Execute("Select F3 From [Şube$] Where F1 = '" & Cells(Target.Row, 1) & "' And F2 = '" & Cells(Target.Row, 2) & "' Group By F3")
           
            If Not Kayit.EOF Then
                Dizi = Application.Transpose(Application.Transpose(Kayit.GetRows))
                With Range("C" & Target.Row)
                    .Validation.Delete
                    .Validation.Add Type:=xlValidateList, Formula1:=Join(Dizi, ",")
                End With
            End If
    End Select

    Set Kayit = Nothing
    Set Baglanti = Nothing
End Sub

Hocam Merhaba olmuş ama unvanla şube ters çıkıyor unvan kısmında şube isimleri şube kısmında unvan çıkıyor

Korhan Ayhan · 22 Mart 2019

Üstteki mesajımdaki kodu ve dosyayı güncelledim. Tekrar deneyiniz.

johnwick5208 · 22 Mart 2019

Korhan Ayhan' Alıntı:
Üstteki mesajımdaki kodu ve dosyayı güncelledim. Tekrar deneyiniz.

Hocam hakkınızı helal edin çok yordum sizi anlamadığım için. Şimdi ben benim asıl tablodan verileri çekebiliyorum. sizin yazdığınız kodda sütunlar A,B ve C'de ya ben bunların sıralamasını I (ilçe), J(Unvan) K (Şube) hücrelerine nasıl aktarabilirim. ABC sütunları yerine IJK sütunlarına aktarmak istiyorum. Lütfen hakkınızı helal edin. ve çok özür dilerim

Çoklu Veri Doğrulama

johnwick5208

ÖmerBey

Destek Ekibi

çıtır

johnwick5208

çıtır

johnwick5208

çıtır

johnwick5208

çıtır

Korhan Ayhan

Administrator

johnwick5208

Korhan Ayhan

Administrator

Ekli dosyalar

johnwick5208

johnwick5208

Korhan Ayhan

Administrator

johnwick5208

Korhan Ayhan

Administrator

Ekli dosyalar

johnwick5208

Korhan Ayhan

Administrator

johnwick5208