Koşullu Listbox seçili satır güncelleme

[gurcannasuh]

Merhaba,
Listbox'a label değerine göre koşullu veri alıyorum. Listboxtaki veriye çift tıklayıp veri güncellemesi yapmak istiyorum ancak bir türlü yapamadım. Koşullu veri aldığım için listboxta seçtiğim veri excelde hangi sıradaysa onu değiştiriyor koşula bakmaksızın.

Listbox'a data çektiğim kodlar;
Private Sub CommandButton20_Click()
Application.ScreenUpdating = False

Application.Workbooks.Open ("C:\Users\gurcan.nasuh\Downloads\Yıllık İzin Takip Programı - Revize Çalışma.xlsx")

ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "80;80;80;80;80;80;80"
ListBox1.ColumnHeads = False
ListBox1.MultiSelect = fmMultiSelectSingle

Dim x As Byte
Dim Buton_Adı() As Variant
Dim Sistem_Genişlik As Long, Sistem_Yükseklik As Long
Dim Form_Genişlik As Long, Form_Yükseklik As Long
Dim Genişlik_Oranı As Double, Yükseklik_Oranı As Double
Dim Nesne As Control


Dim i As Integer
Dim a As Integer
UserForm1.ListBox1.Clear
ListBox1.AddItem ("T.C.Kimlik No")
ListBox1.List(ListBox1.ListCount - 1, 1) = "Adı Ve Soyadı"
ListBox1.List(ListBox1.ListCount - 1, 2) = "İzin Başlangıç Tarihi"
ListBox1.List(ListBox1.ListCount - 1, 3) = "İzin Bitiş Tarihi"
ListBox1.List(ListBox1.ListCount - 1, 4) = "Yarım Gün ? (E)"
ListBox1.List(ListBox1.ListCount - 1, 5) = "Kullanılan İzin Günü"
ListBox1.List(ListBox1.ListCount - 1, 6) = "Kalan İzin Günü"



For i = 2 To ActiveWorkbook.Worksheets("İzin_Girişleri").Range("B1048576").End(xlUp).Row
'For i = 2 To Worksheets("İzin_Girişleri").Range("B1048576").End(xlUp).Row
'For i = 2 To 1000000
'If Worksheets("İzin_Girişleri").Range("B" & i) = Label9 Then
If Worksheets("İzin_Girişleri").Range("B" & i) = "123" Then

ListBox1.AddItem (Worksheets("İzin_Girişleri").Range("B" & i))
ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("İzin_Girişleri").Range("C" & i)
ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("İzin_Girişleri").Range("D" & i)
ListBox1.List(ListBox1.ListCount - 1, 3) = Worksheets("İzin_Girişleri").Range("E" & i)
ListBox1.List(ListBox1.ListCount - 1, 4) = Worksheets("İzin_Girişleri").Range("F" & i)
ListBox1.List(ListBox1.ListCount - 1, 5) = Worksheets("İzin_Girişleri").Range("G" & i)
ListBox1.List(ListBox1.ListCount - 1, 6) = Worksheets("İzin_Girişleri").Range("H" & i)
End If
Next i

ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True

End Sub

Listbox'taki veriyi labellere aktaran kodlar;

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For a = 0 To 2
Next
Label7 = Format(ListBox1.Column(2), "dd.mm.yyyy")
Label8 = Format(ListBox1.Column(3), "dd.mm.yyyy")
sat = ListBox1.List(ListBox1.ListIndex, 5)
Set satir = Sheets("İzin_Girişleri").Range("b:b").Find(SNO, lookat:=xlWhole)
If Not satir Is Nothing Then

End If
End Sub

Veri güncellemesi yapmak istediğim kodlar;


Private Sub CommandButton21_Click()
Application.ScreenUpdating = False

If ListBox1 = Empty Then
MsgBox "Veri kaydı bulunamamıştır.", vbExclamation, "Dikkat !"
Exit Sub
End If

If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden veri seçimi yapınız.", vbExclamation, "Dikkat !"
Exit Sub
End If

If MsgBox("Seçtiğiniz kayıt üzerinde değişiklik yapılacaktır onaylıyor musunuz ?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then

ListBox1.RowSource = Empty

Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "B") = Label9
Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "C") = Label10
Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "D") = Format(Label7, "dd.mm.yyyy")
Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "E") = Format(Label8, "dd.mm.yyyy")

If CheckBox1 = True Then
Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "f") = "E"
Else
Worksheets("İzin_Girişleri").Cells(ActiveCell.Row, "f") = ""
End If

End If

End Sub

 

[Korhan Ayhan]

Merhaba,

Böyle sorularınızda örnek dosya paylaşmanız cevap almanızı kolaylaştıracaktır. Altın üye olmayanlar harici dosya yükleme sitelerini kullanabiliyorlar.

 

[gurcannasuh]

Merhaba,

Dosya linki;

İzin Takip Programı.xlsm

drive.google.com

 

[gurcannasuh]

Merhaba,
Dosya ektedir.