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

B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
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

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Harici dosyo yükleme sitelerinden link verebilirsiniz.
dosya.co
www.dosyaupload.com

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 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.

C++: 
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
 
B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
ÖmerFaruk' Alıntı:
Harici dosyo yükleme sitelerinden link verebilirsiniz.
dosya.co
www.dosyaupload.com

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 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.

C++: 
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
Genişletmek için tıkla ...
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.
 
B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
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

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Verdiğim koda sadece Ana Data sayfanızdan diğer sayfaya kopyalayıp tekrarlayanların silinmesi için bir kod parçasıydı.
 
B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
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.
 
B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
ÖmerFaruk' Alıntı:
Verdiğim koda sadece Ana Data sayfanızdan diğer sayfaya kopyalayıp tekrarlayanların silinmesi için bir kod parçasıydı.
Genişletmek için tıkla ...
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.
 
B

btanju

Katılım
27 Aralık 2019
Mesajlar
66
Excel Vers. ve Dili
Microsoft10
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst