Veri doğrulama koşullu

[topcuexcel]

Merhabalar
Listeden koşullu veri doğrulama (açılır liste) yapmak istiyorum ekteki dosyada problemimi yazdım. İlgilenirseniz çok sevinirim. Teşekkürler.

 

[İhsan Tank]

Merhabalar
Listeden koşullu veri doğrulama (açılır liste) yapmak istiyorum ekteki dosyada problemimi yazdım. İlgilenirseniz çok sevinirim. Teşekkürler.

Merhaba
Eki inceler misiniz
Sayfa2'yi silmeyin orda mükerrer olanlar tek'e düşürülüyor.
Makrolar G2 Hücresine göre çalışır.
Veri - doğrulama - liste özelliğinde dinamik alan kullanılmıştır.

 

[topcuexcel]

İhsan Bey
İlginiz için teşekkür ederim
Ama bir iki müdahalede daha bulunursanız çk sevinirim ;
1. Mamul Adını Sayfa2 de A sütununa aktarıyor ya orada boş satırları ve sıfırları çıkarıp her seferinde Adan Zye sıralama yapabilir mi?
2. Sütun B'de de A daki gibi boş hücreleri çıkarabilir miyiz ?
3. Son olarak da galiba B sütununu bir sonraki seçim için her seferinde temizlemek gerek çünkü bir önceki seçimin ölçüleri kalıyor.

 

[İhsan Tank]

İhsan Bey
İlginiz için teşekkür ederim
Ama bir iki müdahalede daha bulunursanız çk sevinirim ;
1. Mamul Adını Sayfa2 de A sütununa aktarıyor ya orada boş satırları ve sıfırları çıkarıp her seferinde Adan Zye sıralama yapabilir mi?
2. Sütun B'de de A daki gibi boş hücreleri çıkarabilir miyiz ?
3. Son olarak da galiba B sütununu bir sonraki seçim için her seferinde temizlemek gerek çünkü bir önceki seçimin ölçüleri kalıyor.

Merhaba
Sayfa1'in kod bölümüne

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
Sheets("Sayfa2").Range("B:B").ClearContents
kaplan = 1
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = Sheets("Sayfa1").Range("G2") Then
Sheets("Sayfa2").Cells(kaplan, "B") = Sheets("Sayfa1").Cells(ts, "C")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Sayfa2").Cells(65536, "B").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("B2:B" & ts), _
Sheets("Sayfa2").Cells(ts, "B")) > 1 Then
Sheets("Sayfa2").Cells(ts, "B") = ""
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
kaplan = 1
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A2:A" & ts), _
Sheets("Sayfa1").Cells(ts, "A")) = 1 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa1").Cells(ts, "A")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row To 1 Step -1
If Sheets("Sayfa2").Cells(ts, "A") = " " Or Sheets("Sayfa2"). _
Cells(ts, "A") = 0 Then
Sheets("Sayfa2").Cells(ts, "A").Delete
End If
Next
Application.ScreenUpdating = True
End Sub

 

[topcuexcel]

İhsan bey olmuş yalnız bir iki Mamul seçiminde örneğin "KÖŞE RADYATÖR VANASI" nda yada "DÜZ RADYATÖR VANASI" nda mamul seçtikten sonra Ölçü gözükmüyor Sayfa2 ye baktığımda ölçü B1 de değilde B2 de yazıyor. Bundan olabilir mi ? (sanki sadece bir ölçüsü olan Mamullerde bu sorun var)

 

[İhsan Tank]

İhsan bey olmuş yalnız bir iki Mamul seçiminde örneğin "KÖŞE RADYATÖR VANASI" nda yada "DÜZ RADYATÖR VANASI" nda mamul seçtikten sonra Ölçü gözükmüyor Sayfa2 ye baktığımda ölçü B1 de değilde B2 de yazıyor. Bundan olabilir mi ? (sanki sadece bir ölçüsü olan Mamullerde bu sorun var)

Merhaba
bir noktayı atlamışım

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
Sheets("Sayfa2").Range("B:B").ClearContents
kaplan = 1
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If Sheets("Sayfa1").Cells(ts, "A") = Sheets("Sayfa1").Range("G2") Then
Sheets("Sayfa2").Cells(kaplan, "B") = Sheets("Sayfa1").Cells(ts, "C")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Sayfa2").Cells(65536, "B").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("B2:B" & ts), _
Sheets("Sayfa2").Cells(ts, "B")) > 1 Then
Sheets("Sayfa2").Cells(ts, "B") = ""
End If
Next
Sheets("Sayfa2").Range("B:B").Sort key1:=Sheets("Sayfa2").Range("B1"), _
order1:=xlAscending
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("G2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
kaplan = 1
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A2:A" & ts), _
Sheets("Sayfa1").Cells(ts, "A")) = 1 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa1").Cells(ts, "A")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row To 1 Step -1
If Sheets("Sayfa2").Cells(ts, "A") = " " Or Sheets("Sayfa2"). _
Cells(ts, "A") = 0 Then
Sheets("Sayfa2").Cells(ts, "A").Delete
End If
Next
Application.ScreenUpdating = True
End Sub

 

[topcuexcel]

İhsan Bey tam istediğim gibi oldu çok teşekkür ederim. Zahmet verdirdim size sağolun..
İyi geceler.

 

[İhsan Tank]

İhsan Bey tam istediğim gibi oldu çok teşekkür ederim. Zahmet verdirdim size sağolun..
İyi geceler.

Rica ederim
:yazici: