Şartlı veri doğrulama

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Merhaba,

Bir hücrede bulunan metne göre şartlı doğrulma nasıl yapılır?

Yardımlarınız için teşekkür ederim
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Şu konuyu inceleyin:

şartlı veri doğrulama

merhabalar, ekteki excelde masraf formu sayfasında D7 hücresinde şirket seçtiğimde D9 hücresinde de veri doğrulama listesinde sadece o şirketin projelerinin gelmesini istiyorum yardımcı olabilirmisiniz
www.excel.web.tr www.excel.web.tr

Fazlası için örnek dosya paylaşmanız uygun olur.
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
YUSUF44' Alıntı:
Şu konuyu inceleyin:

şartlı veri doğrulama

merhabalar, ekteki excelde masraf formu sayfasında D7 hücresinde şirket seçtiğimde D9 hücresinde de veri doğrulama listesinde sadece o şirketin projelerinin gelmesini istiyorum yardımcı olabilirmisiniz
www.excel.web.tr www.excel.web.tr

Fazlası için örnek dosya paylaşmanız uygun olur.
Genişletmek için tıkla ...
Merhaba, Örnek dosya ektedir.

Teşekkür ederim
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayfa2'de veri doğrulama uygulanacak G8'den itibaren aşağı doğru hücreleri seçin
Veri doğrulama menüsünde Listeyi seçin ve alttaki formül çubuğuna aşağıdaki formülü yazın:

=KAYDIR(Hatlar!$C$8:$C$10;0;KAÇINCI(F8;Hatlar!$C$7:$F$7;0)-1;;)
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
YUSUF44' Alıntı:
Sayfa2'de veri doğrulama uygulanacak G8'den itibaren aşağı doğru hücreleri seçin
Veri doğrulama menüsünde Listeyi seçin ve alttaki formül çubuğuna aşağıdaki formülü yazın:

=KAYDIR(Hatlar!$C$8:$C$10;0;KAÇINCI(F8;Hatlar!$C$7:$F$7;0)-1;;)
Genişletmek için tıkla ...
Teşekkür ederim.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları Sayfa2'nin kod bölümüne (sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F8:F100]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1) = ""
End Sub
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
YUSUF44' Alıntı:
Aşağıdaki kodları Sayfa2'nin kod bölümüne (sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F8:F100]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1) = ""
End Sub
Genişletmek için tıkla ...
Hocam,

Sayfada başka kodlar var. Verdiğinizi kodların arasına ekledim ancak yapamadım. Veri doğrulamada verdiğiniz kodları hatlar yan yana değilde alt alta olunca nasıl düzenlemem gerekir? Hatlarda ki ürün sayıları eşit olmadığından boşluk oluşuyor.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet, ay As String, ara As Range
Dim s As Long, c As Range, f As String, v As Long, sayfalar()
Dim i As Long, sn As Long, col As Long, kl As Range, fl As Long
sayfalar = Array("Bardak", "Sidel", "Ektam", "Smi", "Siapi", "Tisse", "Damacana")
Set s1 = Sheets("Günlük Rapor")
v = s1.Cells(Rows.Count, "C").End(3).Row + 1

'//verdiğiniz kodlar//////////////////////////////
If Intersect(Target, [C8:C100]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1) = ""
'////////////////////////////////////

If Target.Address <> "$J$5" Then Exit Sub
If Target.Value = "" Then s1.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET": Exit Sub
If IsDate(Target.Value) = True Then
s1.Range("B8:G" & v) = ""
If Len(Year(Target.Value)) = 3 Then MsgBox "YIL hatalı": Exit Sub
ay = MonthName(Month(Target.Value), False)
fl = 0
For s = 0 To UBound(sayfalar)
Set s2 = Sheets(sayfalar(s))
'----------------------------------------------
'If s2.Name = "Damacana" Then
s2.Unprotect Password:="699"
'---------------------------------------------------
Set ara = s2.Rows("3:3").Find(ay, , xlFormulas, xlPart, , , False)
Set kl = s2.Range(s2.Cells(8, ara.Column), s2.Cells(Rows.Count, ara.Column + 2)).Find("Toplam", , xlFormulas, xlPart, xlByRows, xlNext, False, , False)
If kl Is Nothing Then
MsgBox s2.Name & " sayfasında TOPLAM satırı bulunamadı" & vbCrLf & "İşlem Yapılamadı"
GoTo 10
End If
If Not ara Is Nothing Then
With s2.Columns(ara.Column)
Set c = .Find(DateValue(Target.Value), , xlFormulas, , xlByRows, xlNext, False, False)
If Not c Is Nothing Then
f = c.Address
Do
v = s1.Cells(Rows.Count, "C").End(3).Row + 1
s1.Cells(v, "B") = s2.Cells(c.Row, c.Column)
s1.Cells(v, "C") = sayfalar(s)
s1.Cells(v, "D") = s2.Cells(c.Row, c.Column + 1)
s1.Cells(v, "E") = s2.Cells(c.Row, c.Column + 2)
s1.Cells(v, "F") = s2.Cells(c.Row, c.Column + 3)
i = 0
fl = 1
If sayfalar(s) = "Damacana" Then
s1.Cells(v, "G") = s2.Cells(c.Row, c.Column + 4)
s2.Cells(c.Row, c.Column + 4) = ""
i = 1
End If
col = c.Column
s2.Cells(c.Row, c.Column) = ""
s2.Cells(c.Row, c.Column + 1) = ""
s2.Cells(c.Row, c.Column + 2) = ""
s2.Cells(c.Row, c.Column + 3) = ""
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> f

sn = s2.Cells(kl.Row, col).End(3).Row
s2.Range(s2.Cells(8, col), s2.Cells(sn, col + 3 + i)).Sort Key1:=s2.Cells(8, col), Order1:=xlAscending
'--------------------------------
'If s2.Name = "Damacana" Then
s2.Protect Password:="699"
'-------------------------------------------------------
End If
End With
End If
10:
Next
If fl = 0 Then MsgBox "Yazılan Tarih Bulunamadı": Exit Sub
If s1.Cells(Rows.Count, "C").End(3).Row > 7 Then
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "GÜNCELLE"
End If
Else
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET"
MsgBox "tarih hatalı"
End If
Range("B8").Select
End Sub
Teşekkür ederim
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kod çakışmaması için sayfanızdaki kodu aşağıdakiyle değiştirin, iki kodu birleştirdim:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet, ay As String, ara As Range
Dim s As Long, c As Range, f As String, v As Long, sayfalar()
Dim i As Long, sn As Long, col As Long, kl As Range, fl As Long
sayfalar = Array("Bardak", "Sidel", "Ektam", "Smi", "Siapi", "Tisse", "Damacana")
Set s1 = Sheets("Günlük Rapor")
v = s1.Cells(Rows.Count, "C").End(3).Row + 1

'//verdiğiniz kodlar//////////////////////////////
If Intersect(Target, [C8:C100]) Is Nothing Then GoTo 30
If Target = "" Then Target.Offset(0, 1) = ""
'////////////////////////////////////

If Target.Address <> "$J$5" Then Exit Sub
If Target.Value = "" Then s1.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET": Exit Sub
If IsDate(Target.Value) = True Then
s1.Range("B8:G" & v) = ""
If Len(Year(Target.Value)) = 3 Then MsgBox "YIL hatalı": Exit Sub
ay = MonthName(Month(Target.Value), False)
fl = 0
For s = 0 To UBound(sayfalar)
Set s2 = Sheets(sayfalar(s))
'----------------------------------------------
'If s2.Name = "Damacana" Then
s2.Unprotect Password:="699"
'---------------------------------------------------
Set ara = s2.Rows("3:3").Find(ay, , xlFormulas, xlPart, , , False)
Set kl = s2.Range(s2.Cells(8, ara.Column), s2.Cells(Rows.Count, ara.Column + 2)).Find("Toplam", , xlFormulas, xlPart, xlByRows, xlNext, False, , False)
If kl Is Nothing Then
MsgBox s2.Name & " sayfasında TOPLAM satırı bulunamadı" & vbCrLf & "İşlem Yapılamadı"
GoTo 10
End If
If Not ara Is Nothing Then
With s2.Columns(ara.Column)
Set c = .Find(DateValue(Target.Value), , xlFormulas, , xlByRows, xlNext, False, False)
If Not c Is Nothing Then
f = c.Address
Do
v = s1.Cells(Rows.Count, "C").End(3).Row + 1
s1.Cells(v, "B") = s2.Cells(c.Row, c.Column)
s1.Cells(v, "C") = sayfalar(s)
s1.Cells(v, "D") = s2.Cells(c.Row, c.Column + 1)
s1.Cells(v, "E") = s2.Cells(c.Row, c.Column + 2)
s1.Cells(v, "F") = s2.Cells(c.Row, c.Column + 3)
i = 0
fl = 1
If sayfalar(s) = "Damacana" Then
s1.Cells(v, "G") = s2.Cells(c.Row, c.Column + 4)
s2.Cells(c.Row, c.Column + 4) = ""
i = 1
End If
col = c.Column
s2.Cells(c.Row, c.Column) = ""
s2.Cells(c.Row, c.Column + 1) = ""
s2.Cells(c.Row, c.Column + 2) = ""
s2.Cells(c.Row, c.Column + 3) = ""
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> f

sn = s2.Cells(kl.Row, col).End(3).Row
s2.Range(s2.Cells(8, col), s2.Cells(sn, col + 3 + i)).Sort Key1:=s2.Cells(8, col), Order1:=xlAscending
'--------------------------------
'If s2.Name = "Damacana" Then
s2.Protect Password:="699"
'-------------------------------------------------------
End If
End With
End If
10:
Next
If fl = 0 Then MsgBox "Yazılan Tarih Bulunamadı": Exit Sub
If s1.Cells(Rows.Count, "C").End(3).Row > 7 Then
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "GÜNCELLE"
End If
Else
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET"
MsgBox "tarih hatalı"
End If
Range("B8").Select
30:
If Intersect(Target, [F8:F100]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1) = ""
End Sub
Diğer isteğinizi bilemedim maalesef.
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
YUSUF44' Alıntı:
Kod çakışmaması için sayfanızdaki kodu aşağıdakiyle değiştirin, iki kodu birleştirdim:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As Worksheet, s2 As Worksheet, ay As String, ara As Range
Dim s As Long, c As Range, f As String, v As Long, sayfalar()
Dim i As Long, sn As Long, col As Long, kl As Range, fl As Long
sayfalar = Array("Bardak", "Sidel", "Ektam", "Smi", "Siapi", "Tisse", "Damacana")
Set s1 = Sheets("Günlük Rapor")
v = s1.Cells(Rows.Count, "C").End(3).Row + 1

'//verdiğiniz kodlar//////////////////////////////
If Intersect(Target, [C8:C100]) Is Nothing Then GoTo 30
If Target = "" Then Target.Offset(0, 1) = ""
'////////////////////////////////////

If Target.Address <> "$J$5" Then Exit Sub
If Target.Value = "" Then s1.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET": Exit Sub
If IsDate(Target.Value) = True Then
s1.Range("B8:G" & v) = ""
If Len(Year(Target.Value)) = 3 Then MsgBox "YIL hatalı": Exit Sub
ay = MonthName(Month(Target.Value), False)
fl = 0
For s = 0 To UBound(sayfalar)
Set s2 = Sheets(sayfalar(s))
'----------------------------------------------
'If s2.Name = "Damacana" Then
s2.Unprotect Password:="699"
'---------------------------------------------------
Set ara = s2.Rows("3:3").Find(ay, , xlFormulas, xlPart, , , False)
Set kl = s2.Range(s2.Cells(8, ara.Column), s2.Cells(Rows.Count, ara.Column + 2)).Find("Toplam", , xlFormulas, xlPart, xlByRows, xlNext, False, , False)
If kl Is Nothing Then
MsgBox s2.Name & " sayfasında TOPLAM satırı bulunamadı" & vbCrLf & "İşlem Yapılamadı"
GoTo 10
End If
If Not ara Is Nothing Then
With s2.Columns(ara.Column)
Set c = .Find(DateValue(Target.Value), , xlFormulas, , xlByRows, xlNext, False, False)
If Not c Is Nothing Then
f = c.Address
Do
v = s1.Cells(Rows.Count, "C").End(3).Row + 1
s1.Cells(v, "B") = s2.Cells(c.Row, c.Column)
s1.Cells(v, "C") = sayfalar(s)
s1.Cells(v, "D") = s2.Cells(c.Row, c.Column + 1)
s1.Cells(v, "E") = s2.Cells(c.Row, c.Column + 2)
s1.Cells(v, "F") = s2.Cells(c.Row, c.Column + 3)
i = 0
fl = 1
If sayfalar(s) = "Damacana" Then
s1.Cells(v, "G") = s2.Cells(c.Row, c.Column + 4)
s2.Cells(c.Row, c.Column + 4) = ""
i = 1
End If
col = c.Column
s2.Cells(c.Row, c.Column) = ""
s2.Cells(c.Row, c.Column + 1) = ""
s2.Cells(c.Row, c.Column + 2) = ""
s2.Cells(c.Row, c.Column + 3) = ""
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> f

sn = s2.Cells(kl.Row, col).End(3).Row
s2.Range(s2.Cells(8, col), s2.Cells(sn, col + 3 + i)).Sort Key1:=s2.Cells(8, col), Order1:=xlAscending
'--------------------------------
'If s2.Name = "Damacana" Then
s2.Protect Password:="699"
'-------------------------------------------------------
End If
End With
End If
10:
Next
If fl = 0 Then MsgBox "Yazılan Tarih Bulunamadı": Exit Sub
If s1.Cells(Rows.Count, "C").End(3).Row > 7 Then
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "GÜNCELLE"
End If
Else
ActiveSheet.Shapes.Range("Button 1").TextFrame.Characters.Text = "KAYDET"
MsgBox "tarih hatalı"
End If
Range("B8").Select
30:
If Intersect(Target, [F8:F100]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1) = ""
End Sub
Diğer isteğinizi bilemedim maalesef.
Genişletmek için tıkla ...
Teşekkür ederim.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Yataya göre değişen veri doğrulama için veri doğrulama formülünü aşağıdakiyle değiştirin. Değiştirirken Hücre aralığı ve sonraki 20'yi olabilecek en çok ürününüze göre değiştirin:

=KAYDIR(Hatlar!$D$6:$W$6;KAÇINCI(F8;Hatlar!$C$7:$C$10;0);0;1;20)
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst