- Katılım
- 5 Eylül 2007
- Mesajlar
- 1,247
- Excel Vers. ve Dili
- ofis 2010
- Altın Üyelik Bitiş Tarihi
- 21-07-2024
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.
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.
Kod:
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
Ekli dosyalar
-
646.5 KB Görüntüleme: 7