userformda (kaydet-değiştir-sil)

[taseraydin]

değerli üstad arkadaşlar
Göndermiş olduğum dosyada
ComboBoxla secilin verilere ait bilgilerin TextBoxlara Aktarılması
ComboBoxla secilin verilere ait bilgilerin Kaydedilmesi-Silinmesi-Değiştirilmesi

ile ilgili bir uygulama yapmaya çalıştım fakat işin içinden çıkamadım lütfen yardım edermisiniz..

 

[Korhan Ayhan]

Selamlar,

İstediğiniz işlemlerle ilgili forumda o kadar güzel örnekler varki arama yaparsanız rahatlıkla ulaşabilirsiniz. Size sadece kendinize uyarlamak kalır.

Konuyla ilgili bilgi sahibi olmak isterseniz aşağıdaki linkteki konuları iyice inceleyiniz.

http://www.excel.web.tr/forumdisplay.php?f=119


Dosyanızdaki kodlarıda aşağıdaki şekilde değiştirip denermisiniz.

Dim Bul As Range
 
Private Sub ComboBox2_Change()
    With Sheets("data")
        Set Bul = .Range("L:L").Find(ComboBox2, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            TextBox32 = .Cells(Bul.Row, "m").Value
            TextBox50 = .Cells(Bul.Row, "n").Value
            TextBox49 = .Cells(Bul.Row, "o").Value
            TextBox46 = .Cells(Bul.Row, "p").Value
            TextBox47 = .Cells(Bul.Row, "q").Value
            TextBox48 = .Cells(Bul.Row, "r").Value
        End If
    End With
End Sub
 
Private Sub CommandButton51_Click()
    If TextBox32 = "" Or TextBox50 = "" Or TextBox49 = "" Or TextBox46 = "" Or TextBox47 = "" Or TextBox48 = "" Then
        MsgBox "Eksik bilgi girdiniz !" & Chr(10) & "Lütfen veri girişi yapınız !", vbCritical
        TextBox50.SetFocus
        Exit Sub
    End If
    With Sheets("data")
        If Not Bul Is Nothing Then
            .Cells(Bul.Row, "m").Value = TextBox32
            .Cells(Bul.Row, "n").Value = TextBox50
            .Cells(Bul.Row, "o").Value = TextBox49
            .Cells(Bul.Row, "p").Value = TextBox46
            .Cells(Bul.Row, "q").Value = TextBox47
            .Cells(Bul.Row, "r").Value = TextBox48
        Else
            Satır = .Cells(65536, "K").End(3).Row + 1
            .Cells(Satır, "m").Value = TextBox32
            .Cells(Satır, "n").Value = TextBox50
            .Cells(Satır, "o").Value = TextBox49
            .Cells(Satır, "p").Value = TextBox46
            .Cells(Satır, "q").Value = TextBox47
            .Cells(Satır, "r").Value = TextBox48
        End If
    End With
End Sub
 
Private Sub CommandButton55_Click()
    With Sheets("data")
        If Not Bul Is Nothing Then
            .Cells(Bul.Row, "m").Value = TextBox32
            .Cells(Bul.Row, "n").Value = TextBox50
            .Cells(Bul.Row, "o").Value = TextBox49
            .Cells(Bul.Row, "p").Value = TextBox46
            .Cells(Bul.Row, "q").Value = TextBox47
            .Cells(Bul.Row, "r").Value = TextBox48
        Else
            MsgBox "Değiştirmek istediğiniz veriyi seçiniz !", vbExclamation
        End If
    End With
End Sub
 
Private Sub CommandButton56_Click()
    ComboBox2.Value = ""
    TextBox46.Value = ""
    TextBox47.Value = ""
    TextBox48.Value = ""
    TextBox49.Value = ""
    TextBox32.Value = ""
    ComboBox2.SetFocus
End Sub
 
Private Sub sendsil_Click()
    If ComboBox2 <> "" Then
        If MsgBox("İlgili kayıt silinecektir !" & Chr(10) & "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then
            Range("K" & Bul.Row & ":R" & Bul.Row).Delete
            Select Case WorksheetFunction.CountA(Range("K:K"))
                Case Is = 1
                    Range("K2") = 1
                Case Is = 2
                    Range("K2") = 1
                    Range("K3") = 2
                Case Is >= 3
                    Range("K2") = 1
                    Range("K2:K" & Range("K65536").End(3).Row).DataSeries xlColumns, xlLinear, xlDay, 1, Trend:=False
            End Select
            UserForm_Initialize
            CommandButton56_Click
        End If
    Else
        MsgBox "Lütfen silinecek veriyi seçiniz !", vbExclamation
    End If
End Sub
 
Private Sub UserForm_Initialize()
    Dim ComboListe As Variant, i As Long
 
    ComboListe = Benzersiz_Liste(Range("data!L2:L15"), True)
 
    ComboBox2.Clear
    
    If ComboListe <> "" Then
        For i = 1 To UBound(ComboListe)
            ComboBox2.AddItem ComboListe(i)
        Next i
    End If
End Sub
 
Private Function Benzersiz_Liste(Aralik As Range, DuzListe As Boolean) As Variant
    Dim Hucre As Range, Benzersiz As New Collection, say As Long, Dizi() As Variant
 
    Application.Volatile
 
    On Error Resume Next
 
    For Each Hucre In Aralik
    If Hucre.Formula <> "" Then
        Benzersiz.Add Hucre.Value, CStr(Hucre.Value)
    End If
    Next Hucre
 
    Benzersiz_Liste = ""
 
    If Benzersiz.Count > 0 Then
        ReDim Dizi(1 To Benzersiz.Count)
            For say = 1 To Benzersiz.Count
                Dizi(say) = Benzersiz(say)
            Next say
        Benzersiz_Liste = Dizi
            If Not DuzListe Then
                Benzersiz_Liste = Application.WorksheetFunction.Transpose(Benzersiz_Liste)
            End If
    End If
    On Error GoTo 0
End Function

 

[taseraydin]

İlginize içten teşekürler mükemmel çalışıyor
Ançak Silme İşlemini K ve R Stunları arasında uygulaması lazım
yani K stunundan önceki ve R stunundan sonraki veriler silinmemesi lazım
önceden belirtmediğim için kusura bakmayınız.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodda gerekli düzeltmeyi yaptım. İncelermisiniz.

 

[taseraydin]

istediğim gibi belli aralıkları siliyor ilginize ve emeğinize teşekürler
işlem gerçekleştikten sonra satıra ait sıra numarasıda silindiğinden sıra atlaması oluşuyor,
tekrar 1 den başlayarak sıralama yaptırmak mümkünmü

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.