Veri doğrulama listesi uzunsa

[samet_can]

çalışma sayfasında uygulama yaparken farklı bir pencere açılıyor hata veriyor dosyada sanırım çok ağır çalışıyor printleyip gönderiyorum
aynı çalışma sayfamızda farklı hücrede aynı işlemi yapmak için ne yapmam gerekiyor epiyi deneme yaptım başaramadım
teşekkürler

 

[samet_can]

verdiği hatayı worde ekledim zamanınızı aldım ama kendi başıma çözemiyorum şimdiden teşekkürler

 

[samet_can]

hücreye veri girildiğinde açılan pencere dosyada

 

[Korhan Ayhan]

Bir sürü mesaj yazmışsınız. Ekte de hata mesajını gösteren dosyanız yok!

 

[samet_can]

ilgili hücreye veri girildiğinde uyarı mesajı run time eror9 subsicript out of range

 

[Korhan Ayhan]

Benim eklediğim dosyayı denediniz mi?

Bu dosyada sorun yaşadınız mı?

Eğer dosyada sorun yoksa kendi dosyanıza uyarlarken mutlaka bir yerlerde hata yapıyorsunuz.

 

[samet_can]

direk sizin eklediğiniz dosya üzerinden konuşuyorum.
herhangi bir değişiklik yapmadım

 

[samet_can]

bir ricam olacak;
örnekte aynı sayfada başka hücre için bu işlemi yapmam için ne gerektiğini söylebilirmisiniz geri kalanını bir şekilde halletmeye çalışım konu çok uzadı farkındayım

 

[Korhan Ayhan]

Üstteki mesajımdaki dosyayı revize ettim. Tekrar deneyiniz.

Başka hücrelerde çalışması için sayfanın kod bölümündeki kodun içindeki aşağıdaki satırı düzenlemeniz gerekiyor.

If Intersect(Target, Range("D37")) Is Nothing Then Exit Sub

Bu bölüm sadece D37 hücrfesinde çalışmasını sağlıyor. Siz bunu aşağıdaki gibi düzenleyebilirsiniz. Bu şekilde belirttiğiniz aralıkta çalışır.

If Intersect(Target, Range("D1:D100")) Is Nothing Then Exit Sub

 

[samet_can]

teşekkür ederim hayırlı akşamlar

 

[samet_can]

revize ettiğiniz dosya ekte bulunmamakta.
Harici aynı işlemi aynı sayfada farklı hücre de uygulamaktan kastım her hücrenin ayrı listesi var

-If Intersect(Target, Range("D37")) Is Nothing Then Exit Sub bu kod istediğim hücre listesini d 37de açıyor
-If Intersect(Target, Range("D1: D100")) Is Nothing Then Exit Sub bu kod ilgili listenin ilgili sayfada her hücrede gösteriyor

talep edilen
banyo wc adlı sayfada d37 hücresin de, Fiyat şablonu sayfasında d542:d559 veriler listeleniyor okey

yine banyo wc adlı sayfada d36 hücresi için; fiyat şablonu adlı sayfasında d516:540 arası veriler için listeyi nasıl çıkartırım
her banyo wc sayfasındaki hücre için ayrı liste mevcut ne yapmam gerekiyor

 

[-serdarali-]

1 sayfada her ayrı hücre için, farlı bir liste oluşturmak mumkunmu ?
mumnkunse her hücre için user form gerekecek

 

[samet_can]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not UserForm1.ListBox1.Tag = "off" Then
If Intersect(Target, Range("D37")) Is Nothing Then Exit Sub
Dim deger As Range
sayac = 0
derlenen = Target.Address
bakilan = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))

For Each deger In Sheets("FİYAT ŞABLONU").Range("D542559")
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
sayac = sayac + 1
sonuc = deger.Value

If sayac = 1 Then
UserForm1.ListBox1.Clear
End If

UserForm1.ListBox1.AddItem deger.Value
End If
Next

If sayac > 1 Then
UserForm1.Tag = derlenen
UserForm1.Caption = "Birden Cok Uygun Kayit Var, Lutfen Birini Seciniz"
UserForm1.ListBox1.Tag = "off"
UserForm1.Show
UserForm1.ListBox1.Tag = ""
ElseIf sayac = 1 Then
UserForm1.ListBox1.Tag = "off"
Range(derlenen) = sonuc
Else
UserForm1.ListBox1.Tag = "off"
bakilan = ""
sayac = 0
For Each deger In Sheets("Sheet1").Range("C3:C83")
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
sayac = sayac + 1
sonuc = deger.Value

If sayac = 1 Then
UserForm1.ListBox1.Clear
End If

UserForm1.ListBox1.AddItem deger.Value
End If
Next
UserForm1.Tag = derlenen
UserForm1.Caption = "Uygun Kayit Bulunamadi, Lutfen Listeden Birini Seciniz"
Range(derlenen) = ""
UserForm1.Show

End If
Else
UserForm1.ListBox1.Tag = ""
End If
End Sub
Private Sub Workshet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not UserForm2.ListBox2.Tag = "off" Then
If Intersect(Target, Range("D38")) Is Nothing Then Exit Sub
Dim deger As Range
sayac = 0
derlenen = Target.Address
bakilan = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))

For Each deger In Sheets("FİYAT ŞABLONU").Range("D54559")
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
sayac = sayac + 1
sonuc = deger.Value

If sayac = 1 Then
UserForm2.ListBox2.Clear
End If

UserForm2.ListBox2.AddItem deger.Value
End If
Next

If sayac > 1 Then
UserForm2.Tag = derlenen
UserForm2.Caption = "Birden Cok Uygun Kayit Var, Lutfen Birini Seciniz"
UserForm2.ListBox2.Tag = "off"
UserForm2.Show
UserForm2.ListBox2.Tag = ""
ElseIf sayac = 1 Then
UserForm2.ListBox2.Tag = "off"
Range(derlenen) = sonuc
Else
UserForm2.ListBox2.Tag = "off"
bakilan = ""
sayac = 0
For Each deger In Sheets("Sheet1").Range("C3:C83")
If Not IsEmpty(deger.Value) And deger.Value Like "*" & bakilan & "*" Then
sayac = sayac + 1
sonuc = deger.Value

If sayac = 1 Then
UserForm2.ListBox2.Clear
End If

UserForm2.ListBox1.AddItem deger.Value
End If
Next
UserForm2.Tag = derlenen
UserForm2.Caption = "Uygun Kayit Bulunamadi, Lutfen Listeden Birini Seciniz"
Range(derlenen) = ""
UserForm2.Show

End If
Else
UserForm2.ListBox2.Tag = ""
End If
End Sub

 

[samet_can]

harici bide user form açtım yine olmadı