ListBox veriyi üste çekme

[bayramagil]

Merhaba, oluşturğum ListBoxta son girilen veri aşağıda kalıyor en üste nasıl çekebilirim ? ayrıca veriye çift tıkladığımda TextBoxlara nasıl aktarabilirim? Destek için teşekkürler,

 

[Korhan Ayhan]

Merhaba,

Linki inceleyiniz.

Userform Listbox' a üsten ekleme

Merhaba, Aşağıdaki kod ile Listbox' a yeni bir ekleme yaparken listenin en altına ekleme yapıyor, yeni eklenen değeri listenin en üstüne ekleme yapılabilir mi? Private Sub TextBox1_Change() If Len(Me.TextBox1) = 13 Then Me.ListBox1.AddItem Me.TextBox1 Me.TextBox1 = "" End If...

www.excel.web.tr

Diğer talebinizle ilgili de forumun arşivinde arama yapabilirsiniz. Bolca örnek var.

 

[bayramagil]

Korhan Hocam Selamlar, ekledim ancak olmadı farklı bir yolu var mıdır?

 

[Korhan Ayhan]

Örnek dosyanızı görmeden yorum yapamam...

 

[bayramagil]

Dim aranan, sil_satır, aranaSeri As Variant

Function varmi(aranan As String, sayfaadi As String, sutun As String) As Long

End Function
Set shbul = Sheets(sayfaadi).Range(sutun & ":" & sutun).Find(aranan, , xlValues, xlWhole)
If Not shbul Is Nothing Then
varmi = shbul.Row
Exit Function
End If
varmi = 0

End Function


Private Sub cbarama_Click()
Dim arananSeri As String
Dim bulundu As Range
Dim satirNumarasi As Long

arananSeri = InputBox("Aranacak seri numarasını girin:", "Seri Numarası Arama")
Sheets("kayıt").Select
If arananSeri = "" Then
MsgBox "Seri numarası girmediniz.", vbExclamation
Exit Sub
End If

Range("F:F").Find(arananSeri).Select

sil_satır = ActiveCell.Row

cbpartner.Value = Worksheets("kayıt").Cells(sil_satır, 1)
tbarizakayit.Value = Worksheets("kayıt").Cells(sil_satır, 2)
tbgönderimkayit.Value = Worksheets("kayıt").Cells(sil_satır, 3)
cburunkodu.Value = Worksheets("kayıt").Cells(sil_satır, 4)
cburunadi.Value = Worksheets("kayıt").Cells(sil_satır, 5)
tbarızalisn.Value = Worksheets("kayıt").Cells(sil_satır, 6)
tbyenisn.Value = Worksheets("kayıt").Cells(sil_satır, 7)
tbmusteriaciklama.Value = Worksheets("kayıt").Cells(sil_satır, 8)
tbservisaciklama.Value = Worksheets("kayıt").Cells(sil_satır, 9)
tbteklif.Value = Worksheets("kayıt").Cells(sil_satır, 10)
tbrma.Value = Worksheets("kayıt").Cells(sil_satır, 11)

Exit Sub

Set bulundu = Columns("F:F").Find(What:=arananSeri, LookIn:=xlValues, LookAt:=xlWhole)

If bulundu Is Nothing Then
MsgBox "Seri numarası bulunamadı.", vbInformation
Else
satirNumarasi = bulundu.Row
MsgBox "Seri numarası bulundu. Satır Numarası: " & satirNumarasi, vbInformation
End If


End Sub

Private Sub cbgüncelle_Click()

Dim arananSeri As String
Dim bulundu As Range
Dim satirNumarasi As Long

arananSeri = TextBoxID.Value
Range("F:F").Find(arananSeri).Select

güncelle = ActiveCell.Row

Worksheets("kayıt").Cells(güncelle, 1) = cbpartner.Value
Worksheets("kayıt").Cells(güncelle, 2) = tbarizakayit.Value
Worksheets("kayıt").Cells(güncelle, 3) = bgönderimkayit.Value
Worksheets("kayıt").Cells(güncelle, 4) = cburunkodu.Value
Worksheets("kayıt").Cells(güncelle, 5) = cburunadi.Value
Worksheets("kayıt").Cells(güncelle, 6) = tbarızalisn.Value
Worksheets("kayıt").Cells(güncelle, 7) = tbyenisn.Value
Worksheets("kayıt").Cells(güncelle, 8) = tbmusteriaciklama.Value
Worksheets("kayıt").Cells(güncelle, 9) = tbservisaciklama.Value
Worksheets("kayıt").Cells(güncelle, 10) = tbteklif.Value
Worksheets("kayıt").Cells(güncelle, 11) = tbrma.Value


End Sub

Private Sub Lbkayıt_Click()
(ListBox)
End Sub

Private Sub Cmdkapat_Click()
Unload Me

End Sub


Private Sub cmdkaydet_Click()

sonsatır = WorksheetFunction.CountA(Worksheets("kayıt").Range("A:A")) + 1
Worksheets("kayıt").Cells(sonsatır, 1) = cbpartner
Worksheets("kayıt").Cells(sonsatır, 2) = tbarizakayit
Worksheets("kayıt").Cells(sonsatır, 3) = tbgönderimkayit
Worksheets("kayıt").Cells(sonsatır, 4) = cburunkodu
Worksheets("kayıt").Cells(sonsatır, 5) = cburunadi
Worksheets("kayıt").Cells(sonsatır, 6) = tbarızalisn
Worksheets("kayıt").Cells(sonsatır, 7) = tbyenisn
Worksheets("kayıt").Cells(sonsatır, 8) = tbmusteriaciklama
Worksheets("kayıt").Cells(sonsatır, 9) = tbservisaciklama
Worksheets("kayıt").Cells(sonsatır, 10) = tbteklif
Worksheets("kayıt").Cells(sonsatır, 11) = tbrma


If obtoptel = True Then
Range("kayıt").Cells(sonsatır, 13).Value = "TOPTEL"
ElseIf obruijie = True Then
Range("kayıt").Cells(sonsatır, 13).Value = "RUİJİE"
ElseIf obextreme = True Then
Range("kayıt").Cells(sonsatır, 13).Value = "EXTREME"
ElseIf obavaya = True Then
Range("kayıt").Cells(sonsatır, 13).Value = "AVAYA"
End If

If cbavayarmaevet = True Then
Range("kayıt").Cells(sonsatır, 12).Value = "EVET"
Else
Range("kayıt").Cells(sonsatır, 12).Value = "HAYIR"
End If

If cbgarantiçi = True Then
Range("kayıt").Cells(sonsatır, 14).Value = "GARANTİ İÇİ"
Else
Range("kayıt").Cells(sonsatır, 14).Value = "GARANTİ DIŞI"
End If

End Sub
Private Sub CommandButton2_Click()
cbpartner.Value = ""
tbgönderimkayit.Value = ""
cburunkodu.Value = ""
cburunadi.Value = ""
tbarızalisn.Value = ""
tbyenisn.Value = ""
tbmusteriaciklama.Value = ""
tbservisaciklama.Value = ""
tbteklif.Value = ""
tbrma.Value = ""

End Sub

Private Sub CommandButton4_Click()

End Sub


Private Sub TextBox2_Change()

End Sub

Private Sub UserForm_Initialize()

tbarizakayit.Text = CDate(Date)

Lbkayıt.ColumnCount = 14
Lbkayıt.RowSource = "kayıt"
Lbkayıt.ColumnWidths = "80,80,80,80,80,80,80,80,80,80,80"
End Sub

 

[bayramagil]

Korhan Hocam merhaba, Bakabildiniz mi acaba nasıl bir yol izlemek lazım bulamadım bir türlü..

 

[Korhan Ayhan]

Örnek dosyanızı görmeden yorum yapamam...

 

[bayramagil]

Hocam Merhaba dosyaya ulaşabileceğiniz link ektedir. Makro demo dosyası

 

[Korhan Ayhan]

Paylaştığınız dosyadaki makrolara erişemiyorum. Sorunlu bir doysa olabilir mi?

Ofis 365 sürümü ile açmaya çalıştığımda onarıma geçip makrolar siliniyor.

 

[bayramagil]

office 2019 ile yaptım ondan olabilir muhtemelen

 

[bayramagil]

Korhan Hocam Veriyi TextBoxlara çekebildim ancak option buttonlarda da istenilen veriyi nasıl seçtirebilirim ? kırmızı ile işaretlediğim alanda denedim ancak olmadı


Private Sub Lbkayıt_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cbpartner = Lbkayıt.List(Lbkayıt.ListIndex, 0) 'ListBox'a tıkladığımızda değerleri textbox'lara alıyoruz.
tbgönderimkayit = Lbkayıt.List(Lbkayıt.ListIndex, 1)
cburunkodu = Lbkayıt.List(Lbkayıt.ListIndex, 2)
cburunadi = Lbkayıt.List(Lbkayıt.ListIndex, 3)
tbarızalisn = Lbkayıt.List(Lbkayıt.ListIndex, 4)
tbyenisn = Lbkayıt.List(Lbkayıt.ListIndex, 5)
tbmusteriaciklama = Lbkayıt.List(Lbkayıt.ListIndex, 6)
tbservisaciklama = Lbkayıt.List(Lbkayıt.ListIndex, 7)
tbteklif = Lbkayıt.List(Lbkayıt.ListIndex, 8)
tbrma = Lbkayıt.List(Lbkayıt.ListIndex, 9)

If cbavayarmaevet = True Then
obtoptel = Lbkayıt.List(Lbkayıt.ListIndex, 10)
ElseIf obruijie = True Then
obruijie = Lbkayıt.List(Lbkayıt.ListIndex, 11)
ElseIf obextreme = True Then
obextreme = Lbkayıt.List(Lbkayıt.ListIndex, 12)
ElseIf obavaya = True Then
obavaya = Lbkayıt.List(Lbkayıt.ListIndex, 13)
End If


End Sub

 

[Korhan Ayhan]

Forumun arşivinde bolca örnek uygulama var. İnceleyip dosyanıza uyarlayabilirsiniz.

Userform ve Nesnelere Yönelik uygulamalar

Bu başlıkta, userform ve nesnelerinin özelliklerini değiştirme, yeni özellikler ilave etme gibi nesneye yönelik uygulamaları bulabilirsiniz.

www.excel.web.tr

Veri Yönetimi Uygulamaları

Bu başlıkta, Veri kaydetme, değiştirme, silme gibi özellikleri içeren veri yönetimi uygulamalarını bulabilirsiniz.

www.excel.web.tr