Listbox satır renklendirme.

[igultekin2000]

merhaba; Userform ile kullandığım çalışmam var. Textbox1 ile veri filtreleyip Listbox1'e getiriyorum. listbox1'deki veriyi Enter ile Sayfa1'in D son dolu hücresine aktarıyorum.
Sayfa1'deki D sütunu boş olan ilk on satırı Listbox3'e otomatik alınıyor, Butonla son boş verileri yeniliyorum.
Benim yapmak istediğim. Listbox3'e alınan verinin hangi satırında işlem yapıldığını görmek, bunu da Sayfa1'in D sütununa veri aktarıldıkça listbox3'ün ilgili satırın renklenmesi veya seçili hale gelmesi, yani Listbox1'den aktardığım verinin hangi satıra gittiğini görmek. Yapılan işlemi takip etmek, zira 10 satırın D sütununa kod aktrıldıktan sonra yeni D sütünü boş 10 satır alıyorum.
gerçi D sütunundaki boş hücreye veri aktarıldıkça Listbox3'deki ilk satırın kaybolması benim için daha uygun ama onu yapamadım.

Private Sub TextBox3_Enter()
    ' TextBox3'e odaklandığında, D sütunundaki son veriyi al
    TextBox3.Value = Worksheets("Sayfa1").Cells(Rows.Count, "D").End(xlUp).Value
End Sub


Private Sub UserForm_Initialize()
    ' Form başlatıldığında ListBox'e belirli sayıda boş satır ekleniyor
    currentRowIndex = 1 ' currentRowIndex değişkenini başlat
    UpdateListBox
End Sub
Private Sub ListBox1_Click()
    ' ListBox1'de herhangi bir öğe seçildiğinde TextBox3'ü güncelle
    UserForm1.TextBox3.Value = ListBox1.Value
End Sub



Private Sub CommandButton1_Click()
    ' CommandButton'a tıklandığında ListBox'e 10 adet daha boş satır ekleniyor
    UpdateListBox
End Sub

Private Sub UpdateListBox()
    Dim ws As Worksheet
    Dim satir As Long
    Dim veri As String
    Dim i As Integer
    Dim columnWidths As String
    Dim separator As String
    Dim emptyRowCount As Long
    
    ' Ayırıcı karakteri belirle
    separator = " | "
    
    ' Çalışma sayfasını belirle
    Set ws = ThisWorkbook.Sheets("Sayfa1")
    
    ' ListBox3 nesnesini temizle
    Me.ListBox3.Clear
    
    ' Sütun genişliklerini ve başlığı belirle
    Dim baslik As String
    Dim genislikler As Variant
    baslik = "A | B | C"
    genislikler = Array(10, 40, 12) ' Sırasıyla A, B ve C sütunları için genişlikler
    
    ' ListBox3'e başlığı ekleyin
    Me.ListBox3.AddItem baslik
    
    ' Sütun genişliklerini ayarla
    For i = LBound(genislikler) To UBound(genislikler)
        columnWidths = columnWidths & genislikler(i) & ";"
    Next i
    Me.ListBox3.columnWidths = columnWidths
    
    ' ListBox'da kaç adet boş satır olduğunu sayın
    emptyRowCount = 0
    For satir = currentRowIndex To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        If IsEmpty(ws.Cells(satir, "D").Value) Then
            emptyRowCount = emptyRowCount + 1
            If emptyRowCount <= 10 Then
                veri = ws.Cells(satir, "A").Value & separator & ws.Cells(satir, "B").Value & separator & ws.Cells(satir, "C").Value
                Me.ListBox3.AddItem veri
            End If
        End If
    Next satir
    
    ' Sonraki alınacak satırın indeksini güncelle
    currentRowIndex = currentRowIndex + 10
    
    ' Satır ve sütunları çizgilerle ayır
    Me.ListBox3.BorderStyle = fmBorderStyleSingle
End Sub




Private Sub TextBox1_Change()
    Dim LastRow As Long
    Dim i As Long
    Dim SearchValue As String
    Dim Found As Boolean
    
    ' Arama değerini TextBox1'den al ve küçük harfe çevir
    SearchValue = LCase(Me.TextBox1.Value)
    
    ' ListBox'ı temizle
    Me.ListBox1.Clear
    
    ' Veri sayfasının B sütununda son satırı bul
    LastRow = Sheets("hsp").Cells(Sheets("hsp").Rows.Count, "B").End(xlUp).Row
    
    ' Arama değerini B sütununda ara
    For i = 1 To LastRow
        If InStr(1, LCase(Sheets("hsp").Cells(i, "B").Value), SearchValue, vbTextCompare) > 0 Then
            ' Eğer aranan değer bulunduysa A ve B sütunlarını ListBox'a ekle
            Me.ListBox1.AddItem Sheets("hsp").Cells(i, "A").Value & " - " & Sheets("hsp").Cells(i, "B").Value
            Found = True
        End If
    Next i
    
    ' Eğer aranan değer bulunamadıysa ListBox'ı temizle
    If Not Found Then
        Me.ListBox1.Clear
    End If
End Sub


Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ' TextBox1'e çift tıkladığınızda içerisindeki veriyi sil
    Me.TextBox1.Value = ""
End Sub

Private Sub TextBox1_GotFocus()
    Dim LastRow As Long
    Dim SelectedValue As String
    
    ' ListBox1'de seçili olan değeri al
    SelectedValue = Me.ListBox1.Value
    
    ' Aktif çalışma sayfasının D sütununda son boş hücreyi bul
    LastRow = Sheets(ActiveSheet.Name).Cells(Sheets(ActiveSheet.Name).Rows.Count, "D").End(xlUp).Row
    
    ' ListBox1'de seçili olan değeri TextBox'a atar
    Me.TextBox1.Value = SelectedValue
    
    ' TextBox içeriğini seçili hale getirir
    Me.TextBox1.SelStart = 0
    Me.TextBox1.SelLength = Len(Me.TextBox1.Text)
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyUp Then ' Yukarı yön tuşuna basıldığında
        Me.TextBox1.SetFocus ' TextBox1'e odaklan
    ElseIf KeyCode = vbKeyReturn Then ' Enter tuşuna basıldığında
        Dim LastRow As Long
        Dim TargetCell As Range
        
        ' ListBox1'de seçili olan değeri al
        Dim SelectedValue As String
        SelectedValue = Me.ListBox1.Value
        
        ' Aktif çalışma sayfasının D sütununda son boş hücreyi bul
        LastRow = Sheets(ActiveSheet.Name).Cells(Sheets(ActiveSheet.Name).Rows.Count, "D").End(xlUp).Row
        Set TargetCell = Sheets(ActiveSheet.Name).Cells(LastRow + 1, "D")
        
        ' Seçili değeri D sütunundaki boş hücreye kopyala
        TargetCell.Value = SelectedValue
    End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyAdd Then ' Artı (+) tuşuna basıldığında
        KeyCode = 0 ' Tuş işlemini iptal et
        Me.TextBox1.Value = "" ' TextBox1'in değerini temizle
    End If
End Sub




Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then ' 2, sağ fare düğmesine karşılık gelir
        TextBox2.Text = ""
    End If
End Sub

Private Sub TextBox2_Change()
    Dim searchText As String
    Dim i As Integer
    Dim LastRow As Integer
    
    searchText = TextBox2.Text
    LastRow = Sheets("FATURA").Cells(Rows.Count, "D").End(xlUp).Row
    
    ListBox2.Clear
    
    For i = 1 To LastRow
        If InStr(1, Sheets("FATURA").Cells(i, "D").Value, searchText, vbTextCompare) > 0 Then
            ListBox2.AddItem Sheets("FATURA").Cells(i, "C").Value & " - " & Sheets("FATURA").Cells(i, "D").Value
        End If
    Next i
End Sub