TextBoxlardaki Verileri ListBoxa Tekrarsız Listeleme

Feylosof · Perşembe saat 20:09'de

İyi akşamlar diliyorum arkadaşlar.
8 ile 47 numaralar arasında textboxlar var. Bunlarda bazı değerler benzerdir. Bazen iki bazen dört veya daha fazla Textbox değeri aynıdır. Bunları listboxa birer defa olacak şekilde nasıl listeleyebilirim?
teşekkür ederim.

hamitcan · Cuma saat 08:47'de

Chatgpt çözümü;
Evet

VBA ile gayet rahat yapılır.
(Muhtemelen Excel VBA kullanıyorsun, ona göre anlatıyorum.)
Ama önce netleştireyim:

TextBox’lar bir UserForm üzerinde mi?
Aşağıdaki çözüm UserForm üzerindeki TextBox8–TextBox47 içindir.
Amaç

TextBox8 ile TextBox47 arasındaki değerleri al
Aynı olanları tek sefer yaz
ListBox’a ekle

En temiz VBA çözümü (Dictionary ile)
VBA’da Dictionary, tekrarları engellemek için en doğru yoldur.
Önce referans ekle
VBA editörde:

Tools > References

Microsoft Scripting Runtime işaretle
Kod

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim i As Integer
Dim deger As String

For i = 8 To 47
deger = Trim(Me.Controls("TextBox" & i).Text)

If deger <> "" Then
If Not dict.Exists(deger) Then
dict.Add deger, Nothing
End If
End If
Next i

Me.ListBox1.Clear

Dim key As Variant
For Each key In dict.Keys
Me.ListBox1.AddItem key
Next key

Ne yapıyor bu kod?

Boş TextBox’ları almaz

Aynı değeri 1 kere ekler

2 tane de olsa, 10 tane de olsa fark etmez

Otomatik çalışır
Alternatif (Referans eklemeden – basit yöntem)

Dim i As Integer
Dim deger As String
Dim varItem As Variant

Me.ListBox1.Clear

For i = 8 To 47
deger = Trim(Me.Controls("TextBox" & i).Text)

If deger <> "" Then
On Error Resume Next
varItem = Application.Match(deger, Me.ListBox1.List, 0)
If IsError(varItem) Then
Me.ListBox1.AddItem deger
End If
On Error GoTo 0
End If
Next i
Küçük ama önemli ipuçları

Trim → boşluk sorunlarını çözer
"abc" ile "ABC" aynı kabul edilsin dersen söyle, ekleyelim
İstersen kaç kere tekrar ettiğini de ListBox’ta gösterebiliriz

İstersen bir üst seviye yapalım:

Sadece en çok tekrar edenleri listeleyelim
Yanına adet sütunu ekleyelim
TextBox’lar yerine dinamik kontrol yapalım

Hangisini istiyorsun?

Feylosof · Cuma saat 09:17'de

hamitcan' Alıntı:
Chatgpt çözümü;
Evet VBA ile gayet rahat yapılır.
(Muhtemelen Excel VBA kullanıyorsun, ona göre anlatıyorum.)
Ama önce netleştireyim:
TextBox’lar bir UserForm üzerinde mi?
Aşağıdaki çözüm UserForm üzerindeki TextBox8–TextBox47 içindir.
Amaç

TextBox8 ile TextBox47 arasındaki değerleri al

Aynı olanları tek sefer yaz

ListBox’a ekle

En temiz VBA çözümü (Dictionary ile)
VBA’da Dictionary, tekrarları engellemek için en doğru yoldur.
Önce referans ekle
VBA editörde:

Tools > References

Microsoft Scripting Runtime işaretle
Kod

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

Dim i As Integer
Dim deger As String

For i = 8 To 47
deger = Trim(Me.Controls("TextBox" & i).Text)

If deger <> "" Then
If Not dict.Exists(deger) Then
dict.Add deger, Nothing
End If
End If
Next i

Me.ListBox1.Clear

Dim key As Variant
For Each key In dict.Keys
Me.ListBox1.AddItem key
Next key

Ne yapıyor bu kod?

Boş TextBox’ları almaz

Aynı değeri 1 kere ekler

2 tane de olsa, 10 tane de olsa fark etmez

Otomatik çalışır
Alternatif (Referans eklemeden – basit yöntem)

Dim i As Integer
Dim deger As String
Dim varItem As Variant

Me.ListBox1.Clear

For i = 8 To 47
deger = Trim(Me.Controls("TextBox" & i).Text)

If deger <> "" Then
On Error Resume Next
varItem = Application.Match(deger, Me.ListBox1.List, 0)
If IsError(varItem) Then
Me.ListBox1.AddItem deger
End If
On Error GoTo 0
End If
Next i
Küçük ama önemli ipuçları

Trim → boşluk sorunlarını çözer

"abc" ile "ABC" aynı kabul edilsin dersen söyle, ekleyelim

İstersen kaç kere tekrar ettiğini de ListBox’ta gösterebiliriz

İstersen bir üst seviye yapalım:

Sadece en çok tekrar edenleri listeleyelim

Yanına adet sütunu ekleyelim

TextBox’lar yerine dinamik kontrol yapalım

Hangisini istiyorsun?

Üstadım size ne kadar teşekkür etsem azdır. TextBoxlar UserForm üzerindedir.
İfade ettiğiniz:

Trim → boşluk sorunlarını çözer
"abc" ile "ABC" aynı kabul edilsin dersen söyle, ekleyelim
İstersen kaç kere tekrar ettiğini de ListBox’ta gösterebiliriz

Şu özellikleri de eklesek muazzam bir şey olacaktır. Saygılar sunarım.

Feylosof · Cuma saat 09:33'de

@hamitcan hocam
varItem = Application.Match(deger, Me.ListBox3.List, 0) şu satırda "Type Mismach hatası veriyor.
VBA çözümü (Dictionary ile) olan kod düzgün çalıştı.

hamitcan · Cuma saat 14:03'de

Listbox ismini kontrol ettiniz mi ? her yerde ListBox3 mü ?

Feylosof · Cuma saat 15:34'de

hamitcan' Alıntı:
Listbox ismini kontrol ettiniz mi ? her yerde ListBox3 mü ?

Evet Hocam

Korhan Ayhan · Dün 02:52 da

Tekrar sayıları için aşağıdaki kodu deneyebilirsiniz.

C++:

Option Explicit

Private Sub CommandButton1_Click()
    Dim My_Array() As Variant, X As Long
    Dim Txt As String, No As Byte, X_Time As Double
    
    X_Time = Timer
    
    ListBox1.Clear
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
    
        For X = 8 To 47
            Txt = Trim(Me.Controls("TextBox" & X).Text)
            If Txt <> "" Then
                If Not .Exists(Txt) Then
                    No = No + 1
                    .Add Txt, No
                    ReDim Preserve My_Array(1 To 2, 1 To No)
                    My_Array(1, No) = Txt
                    My_Array(2, No) = 1
                Else
                    My_Array(2, .Item(Txt)) = My_Array(2, .Item(Txt)) + 1
                End If
            End If
        Next
        
        If .Count > 0 Then
            ListBox1.ColumnCount = 2
            ListBox1.Column = My_Array
        End If
    End With

    MsgBox "İşlem süresi ; " & Format(Timer - X_Time, "0.00") & " Saniye"
End Sub

Feylosof · Dün 15:40 da

@Korhan Ayhan üstadım çok teşekkür ederim. Korhan hocam ikinci sütundaki rakamları bir textboxta toplayabilir miyiz*

Korhan Ayhan · Dün 20:18 da

Deneyiniz.

TextBox50 olarak ayarladım. Siz kendi dosyanıza göre düzenlersiniz.

C++:

Option Explicit

Private Sub CommandButton1_Click()
    Dim My_Array() As Variant, X As Long, Total As Long
    Dim Txt As String, No As Byte, X_Time As Double
    
    X_Time = Timer
    
    ListBox1.Clear
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
    
        For X = 8 To 47
            Txt = Trim(Me.Controls("TextBox" & X).Text)
            If Txt <> "" Then
                If Not .Exists(Txt) Then
                    No = No + 1
                    .Add Txt, No
                    ReDim Preserve My_Array(1 To 2, 1 To No)
                    My_Array(1, No) = Txt
                    My_Array(2, No) = 1
                    Total = Total + 1
                Else
                    My_Array(2, .Item(Txt)) = My_Array(2, .Item(Txt)) + 1
                    Total = Total + 1
                End If
            End If
        Next
        
        If .Count > 0 Then
            ListBox1.ColumnCount = 2
            ListBox1.Column = My_Array
        End If
    End With

    TextBox50 = Format(Total, "#,##0")

    MsgBox "İşlem süresi ; " & Format(Timer - X_Time, "0.00") & " Saniye"
End Sub

Feylosof · Dün 21:24 da

Korhan Ayhan' Alıntı:

Deneyiniz.

TextBox50 olarak ayarladım. Siz kendi dosyanıza göre düzenlersiniz.

C++:

Option Explicit

Private Sub CommandButton1_Click()
    Dim My_Array() As Variant, X As Long, Total As Long
    Dim Txt As String, No As Byte, X_Time As Double
   
    X_Time = Timer
   
    ListBox1.Clear
   
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
   
        For X = 8 To 47
            Txt = Trim(Me.Controls("TextBox" & X).Text)
            If Txt <> "" Then
                If Not .Exists(Txt) Then
                    No = No + 1
                    .Add Txt, No
                    ReDim Preserve My_Array(1 To 2, 1 To No)
                    My_Array(1, No) = Txt
                    My_Array(2, No) = 1
                    Total = Total + 1
                Else
                    My_Array(2, .Item(Txt)) = My_Array(2, .Item(Txt)) + 1
                    Total = Total + 1
                End If
            End If
        Next
       
        If .Count > 0 Then
            ListBox1.ColumnCount = 2
            ListBox1.Column = My_Array
        End If
    End With

    TextBox50 = Format(Total, "#,##0")

    MsgBox "İşlem süresi ; " & Format(Timer - X_Time, "0.00") & " Saniye"
End Sub

Çok teşekkür ederim Korhan Bey emeğinize sağlık

TextBoxlardaki Verileri ListBoxa Tekrarsız Listeleme

Feylosof

hamitcan

Uzman

Feylosof

Feylosof

hamitcan

Uzman

Feylosof

Korhan Ayhan

Administrator

Feylosof

Korhan Ayhan

Administrator

Feylosof