Doğrulama listesinde arama

[Tongunc]

Fuat Bey, sayfaya bir ComboBox ilave edin, adına Emre yazın ve ComboBox'ın verileri alacağı alanı seçip, alan adını "veri" yapın.

Dim nvE As Object

Private Sub Emre_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then
      nvE.Visible = False
      ActiveCell.Offset(1, 0).Select
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Set nvE = ActiveSheet.OLEObjects("Emre")
   On Error GoTo 0
   If nvE Is Nothing Then
      With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
                                      Width:=Target.Width, _
                                      Height:=Target.Height)
         .Name = "Emre"
      End With
      Set nvE = ActiveSheet.OLEObjects("Emre")
   End If

   Set Target = Intersect(Target, Range("B:B"))
   If Target Is Nothing Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   ElseIf Target.Count > 1 Or Target.Row = 1 Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   End If

   With nvE
      Application.ScreenUpdating = False
      .Top = Target.Top
      .Left = Target.Left
      .ListFillRange = "veri"
      .LinkedCell = Target.Address
      .Enabled = True
      .Visible = True
      .Activate
   End With
End Sub

Dosyayı da ekliyorum...

Sayın Murat Bey;
Entera basınca bir alt satıra geçmesi ile ilgili makro bende hata veriyor.
Makro olmadan combobox yapınca entera basınca bir şey olmuyor. ESC ile çıkmanız gerekiyor.
Bunun bir ayarı var mıdır?

 

[tirEdsOuL]

Fuat Bey, sayfaya bir ComboBox ilave edin, adına Emre yazın ve ComboBox'ın verileri alacağı alanı seçip, alan adını "veri" yapın.

Dim nvE As Object

Private Sub Emre_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then
      nvE.Visible = False
      ActiveCell.Offset(1, 0).Select
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Set nvE = ActiveSheet.OLEObjects("Emre")
   On Error GoTo 0
   If nvE Is Nothing Then
      With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
                                      Width:=Target.Width, _
                                      Height:=Target.Height)
         .Name = "Emre"
      End With
      Set nvE = ActiveSheet.OLEObjects("Emre")
   End If

   Set Target = Intersect(Target, Range("B:B"))
   If Target Is Nothing Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   ElseIf Target.Count > 1 Or Target.Row = 1 Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   End If

   With nvE
      Application.ScreenUpdating = False
      .Top = Target.Top
      .Left = Target.Left
      .ListFillRange = "veri"
      .LinkedCell = Target.Address
      .Enabled = True
      .Visible = True
      .Activate
   End With
End Sub

Dosyayı da ekliyorum...

Murat bey merhaba;

Daha önce vermiş olduğumuz bu kodda sadece aşağıda kırmızı ile belirtilen değişiklikleri yapıp kendime göre uyarladım ve olumlu sonuç aldım.
Şöyle bir sorum olacak,
Ben bu doğrulama işlemlerini D8 hücresine "Doseme" adını verdiğim ComboBox'a "DosemeList" adındaki verileri, D6 hücresine "Arac" adını verdiğim ComboBox'a "AracList" adındaki verileri getirmesini istiyorum. Kodları komple kopyalayıp isimlerini değiştirerek denedim ama hata verdi.

Dim nvE As Object
Private Sub [COLOR="Red"]Renk[/COLOR]_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then
      nvE.Visible = False
      ActiveCell.Offset(1, 0).Select
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Set nvE = ActiveSheet.OLEObjects([COLOR="Red"]"Renk"[/COLOR])
   On Error GoTo 0
   If nvE Is Nothing Then
      With ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
                                      Width:=Target.Width, _
                                      Height:=Target.Height)
         .Name = [COLOR="Red"]"Renk"[/COLOR]
      End With
      Set nvE = ActiveSheet.OLEObjects([COLOR="Red"]"Renk"[/COLOR])
   End If

   Set Target = Intersect(Target, Range([COLOR="Red"]"D7"[/COLOR]))
   If Target Is Nothing Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   ElseIf Target.Count > 1 Or Target.Row = 1 Then
      nvE.Visible = False
      nvE.LinkedCell = ""
      Exit Sub
   End If

   With nvE
      Application.ScreenUpdating = False
      .Top = Target.Top
      .Left = Target.Left
      .ListFillRange = [COLOR="Red"]"RenkList"[/COLOR]
      .LinkedCell = Target.Address
      .Enabled = True
      .Visible = True
      .Activate
   End With
End Sub