çok sütunlu veri doğrulama

[bunyaming]

Merhaba sayın Plint

modül1 dediğiniz ado bağlantı adı altına değil sanırım

diğerlerinide denedim aynı hatayı tekrar veriyor.
Tekrar tekrar problemleri farklı seferlerde anlatıp sizi uğraştırmak istemiyorum
yalnız sizden kodları aldıktan sonra şu saate kadar aralıksız denemeler yapıyorum

b5 hücresinin hata vermeme sebebi bağlantıyı kes diyorum sayfa1 temizleniyor ama sanırım yazdığımız kodlardan kaynaklı filtrelenmiş aşağıdaki hücreler (filtre sayfası) aynen duruyor.Mümkünse veri yokken temizlenmesi lazım.
b5 veri doğrulama da ordan aldığı için tekrar bağlan diyene kadar yani sayfa1 de veri yokken hata vermiyor
sayfa 5 de veri varken direkt olarak b5 e tıkladığımda eklediğim uyarıları veriyor
ayrıca bu dosyada ki makroları çalıştırdığımda veya dosyayı kapattığımda yine eklediğim resimlerde ki gibi bir kaydetme hatası veya tekrar tekrar kaydetmek istiyor.
Vaktiniz olduğunda çözüm için yardım edebilirseniz çok sevinirim.
Bunlara çözüm bulabilirsek benim için program kusursuz olacaktır.

Teşekkürler

 

[PLİNT]

Merhaba
Siteye eklediğiniz resim ve dosyalar bakma imkanm yok,
Ek dosyadada "veri doğrulama" ya alınacak bilgiler "Sayfa2" "N:X" sütunlarına alınacak
buralardan ilgili hücrelere eklenecek, doğrulama bilgilerine ulaşamadığından meydana gelen sorun varsa engellenecektir
http://s7.dosya.tc/server2/ce6hdn/ACIK_-_Kopya4.zip.html
Açılış ve kapanıştaki silme kodları yok
"Modül 3" te bulunan eski "veridoğrula" makrosu silindi

[SIZE="2"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B4:B10,B12:B14")) Is Nothing Then Exit Sub
Dim liste(), s1 As Worksheet, s2 As Worksheet, gh As String, j As Integer
Dim sutun(), satır As Variant, sut As String: Dim i As Long
Dim x As Long, rw As Long: Dim dc As Object
Set s2 = Sheets("Sayfa2")
Set dc = CreateObject("Scripting.Dictionary")
dc.CompareMode = vbTextCompare
Set s1 = Sheets("FİLTRE"): gh = "L": j = 26
If WorksheetFunction.CountA(Range("B4:B10,B12:B14")) = 0 Or _
s1.Cells(Rows.Count, "A").End(xlUp).Row = 25 Then
Set s1 = Sheets("Sayfa1")
gh = "E": j = 2
End If
sutun = Array("C", gh, "G", "H", "K", "D", "M", "B", "A", "AF")
satır = Array("4", "5", "6", "7", "8", "9", "10", "12", "13", "14")
For x = 0 To UBound(satır)
If Target.Row = satır(x) Then sut = sutun(x)
Next
rw = s1.Cells(Rows.Count, sut).End(xlUp).Row
If j = rw Then
Target.Validation.Delete
s2.Range(s2.Cells(1, Target.Row + 10), s2.Cells(Rows.Count, Target.Row + 10)) = ""
s2.Cells(1, Target.Row + 10) = s1.Range(sut & j)
Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Sayfa2!" & s2.Cells(1, Target.Row + 10).Address
[COLOR="blue"]GoTo 10:[/COLOR]
Else
liste = s1.Range(sut & j & ":" & sut & rw)
End If
For i = 1 To UBound(liste)
If Not dc.exists(liste(i, 1)) And liste(i, 1) <> "" Then dc.Add liste(i, 1), ""
Next
Target.Validation.Delete
s2.Range(s2.Cells(1, Target.Row + 10), s2.Cells(Rows.Count, Target.Row + 10)) = ""
s2.Cells(1, Target.Row + 10).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(dc.keys)
Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Sayfa2!" & s2.Range(s2.Cells(1, Target.Row + 10), s2.Cells(dc.Count, Target.Row + 10)).Address
[COLOR="Blue"]Set dc = Nothing: Erase liste:
10:
If Target.Row = 13 Or Target.Row = 14 Then
For d = 1 To s2.Cells(Rows.Count, Target.Row + 10).End(3).Row
s2.Cells(d, Target.Row + 10) = CDate(Format(CDate(s2.Cells(d, Target.Row + 10)), "dd.mm.yyyy"))
Next
End If[/COLOR]
End Sub
[/SIZE]

 

[bunyaming]

Merhaba Sayın Plint

yazdığınız kodu ekledim.

Filtre sayfasını temizle eklemesinide uyarladım.
Şuan tam istedim gibi oldu
Herhangi bir hata veya problem kalmadı.

Çok teşekkür ediyorum

sağolun

iyi günler

 

[bunyaming]

Merhaba Sayın Plint

Bugün düzenlediğiniz şekli ile

Hata yok,problemsiz çalışıyor

Hata olarak görünen sadece şu kaldı oda formülle alakalı diye epey uğraştım ama bir türlü olmadı

b4:b12 dahil arasında hiç problem yok
b12 de aylardan birini seçtiğimde b4:b14 veri doğrulama içeriği ona göre listeliyor
yalnız problem şurada oluşuyor
b13 de seçilen aya ait günlerden birini seçtiğimde filtre otomatik temizleniyor
a26:ag50000 arasında hiç veri kalmıyor.
bu formüldenmi kaynaklanıyor
uyarladığımız kodlardanmı acaba?

b13 için şu formül tanımlı

=EĞER(B13="";">=01/01/2017";">="&B13)

b14 için şu formül tanımlı

=EĞER(B14="";"<=01/09/2030";"<="&B14)

Bu sorunun haricinde çok hızlı ve problemsiz çalışıyor.

Tekrar yardımcı olabilirseniz sevinirim

Teşekkürler

 

[PLİNT]

Merhaba
Sorun formülde değilde "Sayfa2" ye eklenen tarihleri metin olarak algılıyor olmalı,
yukarıdaki değişen (kodların sonunda, mavi Kısımlar) "Worksheet_SelectionChange" kodlarını deneyin.

 

[bunyaming]

Merhaba Sayın Plint

son gönderdiğiniz kodlar ile problem giderildi.

Çok Teşekkürler

iyi günler