Koşullu Veri Doğrulama

[Ex-cel-ist]

Merhaba Arkadaşlar,

Forumda yeniyim, veri doğrulama ile bir şeyler yapmaya çalışıyordum, eklediğim dosyada sayfa2 de tanımlamarım var ( ve bu listenin altına devamlı olarak veri ekliyeceğim ve çok fazla tanımlamam var ), sayfa 1 de seçtiğim üründen sonra, rengini veri doğrulama ile açılan liste ile seçmek istiyorum, ama ürün rengini sayfa 2 de tanımladığım listeden o ürün için tanımlı renkleri getirmeli,

dolaylı ( veya indirect ) komutu ile ad tanımlayarak yapılan bir takım örnekler buldum ( genelde il - ilçe ile yapılan örnekler var ) fakat tanımlama listem çok uzun ve çok fazla değişkenim var,

değerli yardımlarınızı bekliyorum

 

[Ex-cel-ist]

Bu arada, maalesef dosya yı yükleyemiyorum, "you may not post attachments" şeklinde bir ibare var gönderim kurallarında

 

[antonio]

Bu arada, maalesef dosya yı yükleyemiyorum, "you may not post attachments" şeklinde bir ibare var gönderim kurallarında

dosya.tc sitesinden "Upload" (yükle) sekmesinden "Browse" (bilgisayarımda ara) ile dosyanızı seçtikten sonra >> Upload (yükle) düğmesine bastığınızda dosyanız siteye yüklenir. Ekrana gelen kutucuktaki yazıyı seçip paylaştığınızda dosyanıza ulaşılabilir. Umarım anlaşılır bir şekilde anlatmışımdır.
Kolay gelsin
Not: Tecrübelerden hareketle, (uzantıya dikkat) dosya.co olan sitelere bulaşmayınız. Genellikle virüs içerirler.

 

[Ex-cel-ist]

Selamlar, wetransfer den bir link aldım, https://we.tl/YYEMkaqKTC

herhalde aynı işi görür diye tahmin ediyorum

 

[Ex-cel-ist]

Merhabalar,

İnternet te bu şekilde bir kod grubu buldum fakat maalesef çalıştıramadım,

Option Explicit
*
Private Sub Worksheet_Change(ByVal Target As Range)
****Dim i As Long, LastRow As Long, n As Long
****Dim MyCol As Collection
****Dim SearchString As String, TempList As String
*
****Application.EnableEvents = False
*
****On Error GoTo Whoa
*
**** '~~> Find LastRow in Col A
****LastRow = Range("A" & Rows.Count).End(xlUp).Row
*
****If Not Intersect(Target, Columns(1)) Is Nothing Then
********Set MyCol = New Collection
*
******** '~~> Get the data from Col A into a collection
********For i = 1 To LastRow
************If Len(Trim(Range("A" & i).Value)) <> 0 Then
****************On Error Resume Next
****************MyCol.Add CStr(Range("A" & i).Value), CStr(Range("A" & i).Value)
****************On Error GoTo 0
************End If
********Next i
*
******** '~~> Create a list for the DV List
********For n = 1 To MyCol.Count
************TempList = TempList & "," & MyCol
********Next
*
********TempList = Mid(TempList, 2)
*
********Range("D1").ClearContents: Range("D1").Validation.Delete
*
******** '~~> Create the DV List
********If Len(Trim(TempList)) <> 0 Then
************With Range("D1").Validation
****************.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
****************xlBetween, Formula1:=TempList
****************.IgnoreBlank = True
****************.InCellDropdown = True
****************.InputTitle = ""
****************.ErrorTitle = ""
****************.InputMessage = ""
****************.ErrorMessage = ""
****************.ShowInput = True
****************.ShowError = True
************End With
********End If
**** '~~> Capturing change in cell D1
****ElseIf Not Intersect(Target, Range("D1")) Is Nothing Then
********SearchString = Range("D1").Value
*
********TempList = FindRange(Range("A1:A" & LastRow), SearchString)
*
********Range("E1").ClearContents: Range("E1").Validation.Delete
*
********If Len(Trim(TempList)) <> 0 Then
************ '~~> Create the DV List
************With Range("E1").Validation
****************.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
****************xlBetween, Formula1:=TempList
****************.IgnoreBlank = True
****************.InCellDropdown = True
****************.InputTitle = ""
****************.ErrorTitle = ""
****************.InputMessage = ""
****************.ErrorMessage = ""
****************.ShowInput = True
****************.ShowError = True
************End With
********End If
****End If
*
LetsContinue:
****Application.EnableEvents = True
****Exit Sub
Whoa:
****MsgBox Err.Description
****Resume LetsContinue
End Sub
*
'~~> Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
****Dim aCell As Range, bCell As Range, oRange As Range
****Dim ExitLoop As Boolean
****Dim strTemp As String
*
****Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
****lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
****MatchCase:=False, SearchFormat:=False)
*
****ExitLoop = False
*
****If Not aCell Is Nothing Then
********Set bCell = aCell
********strTemp = strTemp & "," & aCell.Offset(, 1).Value
********Do While ExitLoop = False
************Set aCell = FirstRange.FindNext(After:=aCell)
*
************If Not aCell Is Nothing Then
****************If aCell.Address = bCell.Address Then Exit Do
****************strTemp = strTemp & "," & aCell.Offset(, 1).Value
************Else
****************ExitLoop = True
************End If
********Loop
********FindRange = Mid(strTemp, 2)
****End If
End Function

 

[antonio]

Sayın Ex-cel-ist,
Size bir upload sitesi tavsiye etmiştim. (dosya.tc) Dosya yüklemek için üyelik falan da gerekmiyor. Gmail in drive hizmeti aynı işi görüyor.
Kodları; daima kod penceresine yazınız. Kod penceresine yazmak için, kullanmakta olduğunuz mesaj penceresinde # işaretine basmanız yeterlidir. Ekranda oluşan

 ...sizin kodlarınız...[\code] işaretlerinin arasına kodlarınızı yazabilirsiniz.