TextBox'a yazılan harfe göre ListBox ta süzmek

[btanju]

Selamlar,

Altın Üye olmadığımda örnek dosya yükleyemiyorum. Anlatabildiğim kadar bir soru sormak istiyorum.

Sheets("AnaData") "U3:U10000" veriyi kopyalayıp
Sheets("DataBilgileri") "U3" itibaren yapıştırsın ve aynı verileri silinebiliyorsa silinmesini istemekteyim.

ListBox1' e bu verilerin gelmesini istemekteyim. TextBox1' e yazdığımda ListBox1 de süzülmesini ve tek tıklamada TexBox1 de gözükmesini istemekteyim. TexBox1' de veri silinince Tekrar yazılınca Tekrar Süzülmesini istemekteyim. Karışık olduysa isteklerim kusurabakmayın.

 

[ÖmerFaruk]

Harici dosyo yükleme sitelerinden link verebilirsiniz.
dosya.co

Dosya Upload - Dosya Yükle indir

Ücretsiz olarak dosya upload edebileceğiniz dosya yükleme sitesi. Hızlı dosya yükle ve paylaş.

www.dosyaupload.com

gibi

Sorunuzun ilk kısmı için aşağıdaki kodu kullanabilir, diğer kısımları için yine bu kodlardan örnek alabilirsiniz.

Sub ozet()
   ' Forumda dün paylaşılmış benzer bir konu başlığından alınmış kodlar uyarlanmıştır
    Dim d As Object, i As Long, deg, son As Long
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    For i = 3 To 10000
        deg = Sheets("AnaData").Cells(i, "U")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
    Sheets("DataBilgileri").Range("U3:U10000").ClearContents
    Sheets("DataBilgileri").Range("U3").Resize(d.Count) = Application.Transpose(d.keys)
 
    Application.ScreenUpdating = True
End Sub

 

[btanju]

Harici dosyo yükleme sitelerinden link verebilirsiniz.
dosya.co

Dosya Upload - Dosya Yükle indir

Ücretsiz olarak dosya upload edebileceğiniz dosya yükleme sitesi. Hızlı dosya yükle ve paylaş.

www.dosyaupload.com

gibi

Sorunuzun ilk kısmı için aşağıdaki kodu kullanabilir, diğer kısımları için yine bu kodlardan örnek alabilirsiniz.

Sub ozet()
   ' Forumda dün paylaşılmış benzer bir konu başlığından alınmış kodlar uyarlanmıştır
    Dim d As Object, i As Long, deg, son As Long
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    For i = 3 To 10000
        deg = Sheets("AnaData").Cells(i, "U")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
    Sheets("DataBilgileri").Range("U3:U10000").ClearContents
    Sheets("DataBilgileri").Range("U3").Resize(d.Count) = Application.Transpose(d.keys)

    Application.ScreenUpdating = True
End Sub

Hocam bu yaptığınız kod User Form için mi Makro için m kusurabakmayın anlamadım.

Private Sub Textbox1_Change()
Dim d As Object, i As Long, deg, son As Long
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 3 To 10000
deg = Sheets("LevazimDepo").Cells(i, "U")
If Not d.Exists(deg) Then
d.Add deg, Nothing
End If
Next i
Sheets("DataBilgileri").Range("U3:U10000").ClearContents
Sheets("DataBilgileri").Range("U3").Resize(d.Count) = Application.Transpose(d.keys)

Application.ScreenUpdating = True
End Sub

TexBox1 ' in içine işledim ama olmadı ben mi yanlış yaptım.

 

[btanju]

Aşağıdaki gibi bir kod buldum fakat veriler faklı yerde olduğundan dolayı illede o sayfada olması gerekior UserFormun çalışması için

Private Sub Textbox1_Change()
Application.ScreenUpdating = False
On Error Resume Next
TextBox1 = Evaluate("=büyükharf(""" & TextBox1 & """)")
TextBox1 = Evaluate("=upper(""" & TextBox1 & """)")
ListBox1.Clear
If TextBox1.text = "" Then
Call UserForm_initialize
Else
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
If Cells(i, "U").Value Like TextBox1.text & "*" Then
ListBox1.AddItem .Cells(i, "U").Value
End If
Next i
End With
End If
End Sub

Private Sub UserForm_initialize()
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
ListBox1.AddItem .Cells(i, "U").Value
Next i
End With
End Sub

Ben hangi sayfada olursam olayım user formum Sheets("DataBilgileri") içinde olan verilerin görmesini istiyorum acaba ne yapmam gerekiyor.

 

[ÖmerFaruk]

Verdiğim koda sadece Ana Data sayfanızdan diğer sayfaya kopyalayıp tekrarlayanların silinmesi için bir kod parçasıydı.

 

[btanju]

Aşağıdaki gibi bir kod buldum fakat veriler faklı yerde olduğundan dolayı illede o sayfada olması gerekior UserFormun çalışması için

Private Sub Textbox1_Change()
Application.ScreenUpdating = False
On Error Resume Next
TextBox1 = Evaluate("=büyükharf(""" & TextBox1 & """)")
TextBox1 = Evaluate("=upper(""" & TextBox1 & """)")
ListBox1.Clear
If TextBox1.text = "" Then
Call UserForm_initialize
Else
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
If Cells(i, "U").Value Like TextBox1.text & "*" Then
ListBox1.AddItem .Cells(i, "U").Value
End If
Next i
End With
End If
End Sub

Private Sub UserForm_initialize()
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
ListBox1.AddItem .Cells(i, "U").Value
Next i
End With
End Sub

Ben hangi sayfada olursam olayım user formum Sheets("DataBilgileri") içinde olan verilerin görmesini istiyorum acaba ne yapmam gerekiyor.

 

[btanju]

Verdiğim koda sadece Ana Data sayfanızdan diğer sayfaya kopyalayıp tekrarlayanların silinmesi için bir kod parçasıydı.

Teşekkür ederim hocam kod mükammel peki aşağıdaki konu hakkında bir bilginiz varmıdır. Olumlu yada olumsuz bir cevap veren daha olmadıda yardımcı olabilirmisiniz.

Aşağıdaki gibi bir kod buldum fakat veriler faklı yerde olduğundan dolayı illede o sayfada olması gerekior UserFormun çalışması için

Private Sub Textbox1_Change()
Application.ScreenUpdating = False
On Error Resume Next
TextBox1 = Evaluate("=büyükharf(""" & TextBox1 & """)")
TextBox1 = Evaluate("=upper(""" & TextBox1 & """)")
ListBox1.Clear
If TextBox1.text = "" Then
Call UserForm_initialize
Else
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
If Cells(i, "U").Value Like TextBox1.text & "*" Then
ListBox1.AddItem .Cells(i, "U").Value
End If
Next i
End With
End If
End Sub

Private Sub UserForm_initialize()
With Sheets("DataBilgileri")
For i = 3 To .Range("U65536").End(3).Row
ListBox1.AddItem .Cells(i, "U").Value
Next i
End With
End Sub

Ben hangi sayfada olursam olayım user formum Sheets("DataBilgileri") içinde olan verilerin görmesini istiyorum acaba ne yapmam gerekiyor.

 

[btanju]

Selamlar,
Başkasının işine belki yarar diye başka bir SİTEDEN (okutkan) arkadaş yardımcı oldular. Bilgi paylaşdıkça güzeldir.

Private Sub Textbox1_Change()
Application.ScreenUpdating = False
On Error Resume Next
Dim sf As Worksheet
Set sf = Sheets("DataBilgileri")
son = sf.Cells(Rows.Count, "U").End(3).Row
Application.ScreenUpdating = False
On Error Resume Next
TextBox1 = Evaluate("=büyükharf(""" & TextBox1 & """)")
TextBox1 = Evaluate("=upper(""" & TextBox1 & """)")
ListBox1.Clear
If TextBox1.Text = "" Then
Call UserForm_initialize
Else
For i = 3 To son
If sf.Cells(i, "U").Value Like TextBox1.Text & "*" Then
ListBox1.AddItem sf.Cells(i, "U").Value
End If
Next i
End If
End Sub

Private Sub UserForm_initialize()
Application.ScreenUpdating = False
On Error Resume Next
Dim sf As Worksheet
Set sf = Sheets("DataBilgileri")
son = sf.Cells(Rows.Count, "U").End(3).Row
For i = 3 To son
ListBox1.AddItem sf.Cells(i, "U").Value
Next i
End Sub