makro ile veri doğrulama !!!

[Endless033]

arkadaşlar tanımlar sayfasındaki A2-H2 arasındaki hücreleri veri sayfasındaki j hücresi satırlara açılır veri doğrulama yapmak istiyorum ve en son satıra kadar olacak çok veri girilecek , k hücresi satırlara j hücresindeki alt taplosundaki verileri dolaylı yapmak istiyorum bilgisi olan yardım ederse sevinir

 

[Endless033]

arkaşlar yapmak istediğim veri sayfaısndaki nevi türü 1 sutunana tanımlar sayfasındaki ana başlıklarlar nevi türü2 hücrelerinede alt taplosu gelecek şekilde veri doğrulaması yapmak istiyorum açılır menü yani
dip no: çok veri gireceğim onun için son satıra kadar uyarlasak iyi olur.

 

[Ziynettin]

Veri sayfası kod yordamında deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 10 Then
        If Target.Row > 3 Then
            Dim sh As Worksheet, dc As Object
            Set sh = Sheets("TANIMLAR")
            Set dc = CreateObject("scripting.dictionary")
            a = sh.[A2:H2].Value
            For y = 1 To UBound(a, 2)
                dc(a(1, y)) = ""
            Next y
            Target.Validation.Delete
            Target.Validation.Add xlValidateList, Formula1:=Join(dc.Keys, ",")
        End If
    End If
End Sub

 

[Korhan Ayhan]

Alternatif,

J ve K sütunlarında sağ tıkladığınızda menüler değişir. Önce J sütununda seçim yapın. Ardından K sütununda yaptığınız seçime göre alt menü oluşacaktır.

 

[Korhan Ayhan]

Dosya boyutu büyük olduğu için foruma yük olmaması adına küçülterek foruma yeniden yükledim.

 

[Endless033]

Alternatif,

J ve K sütunlarında sağ tıkladığınızda menüler değişir. Önce J sütununda seçim yapın. Ardından K sütununda yaptığınız seçime göre alt menü oluşacaktır.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
Set S2 = ThisWorkbook.Worksheets("ÜYE İLK KAYIT")
sonn = S2.Range("A65536").End(xlUp).Row
sat = Target.Row
süt = Target.Column
If sat >= 4 And süt = 2 Then
Cells(sat, "c") = "": Cells(sat, "g") = ""
aranan = Cells(sat, "b"): bulunansat = 0
bulunansat = WorksheetFunction.Match(aranan, S2.Range("a1:a" & sonn), 0)
If bulunansat >= 3 Then
Cells(sat, "c") = S2.Cells(bulunansat, "c")
Cells(sat, "d") = S2.Cells(bulunansat, "g")
End If
End If
End Sub


korkan bey veri sayfasında bu kodu yazmak istiyorum sizinki ile aynı anda çalışma için nasıl düzenleyebiliriz

 

[Endless033]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
Set S2 = ThisWorkbook.Worksheets("ÜYE İLK KAYIT")
sonn = S2.Range("A65536").End(xlUp).Row
sat = Target.Row
süt = Target.Column
If sat >= 4 And süt = 2 Then
Cells(sat, "c") = "": Cells(sat, "g") = ""
aranan = Cells(sat, "b"): bulunansat = 0
bulunansat = WorksheetFunction.Match(aranan, S2.Range("a1:a" & sonn), 0)
If bulunansat >= 3 Then
Cells(sat, "c") = S2.Cells(bulunansat, "c")
Cells(sat, "d") = S2.Cells(bulunansat, "g")
End If
End If
End Sub


korkan bey veri sayfasında bu kodu yazmak istiyorum sizinki ile aynı anda çalışma için nasıl düzenleyebiliriz

tamam çözdüm korkan bey tşkler
aslında bu dosyaya bir userform yapmak istiyorum seçimleri oradan yapıp devamlı altına kaydetmesini sağlamak lazım ben bu veri sayfasını veri tabanı gibi kullanmak istiyorum açıkçası çünkü veri sayfası değerli olacak benim için orayla pek bir işim yok sadece user formla oraya yazdıra bilirsek iyi olacak ,amacım verileri bir yerde toplamak gider türlerine göre toplamlarını bir sayfada topladım , raporlama sayfası oluşturdum veri sayfasındaki istediğin değere tarih aralığına göre raporluyor biraz daha nasıl geliştirilebilir bilmiyorum düşüncem sadece user form kaldı

 

[Endless033]

Veri sayfası kod yordamında deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 10 Then
        If Target.Row > 3 Then
            Dim sh As Worksheet, dc As Object
            Set sh = Sheets("TANIMLAR")
            Set dc = CreateObject("scripting.dictionary")
            a = sh.[A2:H2].Value
            For y = 1 To UBound(a, 2)
                dc(a(1, y)) = ""
            Next y
            Target.Validation.Delete
            Target.Validation.Add xlValidateList, Formula1:=Join(dc.Keys, ",")
        End If
    End If
End Sub

kardeşim yardımcı olduğun için tşk ederim korkan beyin uyarladığı daha okunaklı oldu onu uyarladım sağol bilgi paylaşımın için

 

[Korhan Ayhan]

Altın üyeliğiniz var. Forumda userform yönetimi ile ilgili bolca konu var. Kendinize uyarlamalısınız. Benim bunun için maalesef vaktim yok.

Excel İçin Örnek Uygulamalar

Kendi yaptığınız veya harici Excel çalışmalarının kısa açıklaması ile linkini buradan paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)

www.excel.web.tr

 

[Endless033]

Altın üyeliğiniz var. Forumda userform yönetimi ile ilgili bolca konu var. Kendinize uyarlamalısınız. Benim bunun için maalesef vaktim yok.

Excel İçin Örnek Uygulamalar

Kendi yaptığınız veya harici Excel çalışmalarının kısa açıklaması ile linkini buradan paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)

www.excel.web.tr

sağolun düşünmeniz yeterli