satır silme

[ahmett46]

slm
ardım forumda bulamadım. Kayıt yap tuşu ile isim alfabetik olarak B sütununa ve diğer veriler ismin kaydedildiği satırın diğer hücrelerine kayıt yapıyor. A sütununa otomatik olarak sıra numarası veriyor. Verileri ListBox tan seçerek silmek istiyorum. Ancak sileceğim satırdaki A sütunundaki sıralanan sıra numarası bozulmaması gerekiyor. Yani 20 kişilik bir listeden 10. sıradaki bir ismi silmek istediğimde ilgili satırı silecek ancak sıra numarası değişmeyecek.A sütununda silindikten sonra en son veri 19 olacak. Teşekkürler..

Forumda aşağıdaki şekilde bir kod buldum ama çalışmıyor.
Private Sub sil_Click()
On Error Resume Next
Sheets("veri").Select
If A.Text = "sıra no" Then
MsgBox "sıra no Değeri silinemez, program tarafından kullanılıyor...", , "Sil Hatası!!!"
Exit Sub
End If
Dim say As Integer
Dim I As Integer
Dim bos As Range
For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If B.Value = "" Or bos = "" Or ActiveCell = "" Then
MsgBox "Önce kaydını sileceğiniz kişiyi listeden seçmelisiniz."
Exit Sub
End If
Next bos
If MsgBox(B.Value & " isimli kişiye ait kayıt tamamen silinecek, silmek istiyor musunuz?", vbQuestion + vbYesNo, "Dikkat") = vbYes Then

Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 16).Address(False, False)).Delete Shift:=xlUp
say = WorksheetFunction.CountA(Range("A2:A65500"))
For I = 1 To say
Cells(I + 1, 1) = I
Next I

A.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
MsgBox " " & B.Value & " isimli kişiye ait tüm bilgiler silinmiştir.", vbInformation, "Sendika Programı"
formutemizle_Click

ComboBox2_Change
A.SetFocus
Unload Personel
Personel.Show
End If
End Sub

 

[ahmett46]

Yok mu yardım edecek kimse??

 

[Korhan Ayhan]

Selamlar,

Vermiş olduğunuz kodda zaten sıra no veren kodlama mevcut. Sadece aşağıdaki şekilde düzenlemeniz gerekiyor.

Mevcut kod;

say = WorksheetFunction.CountA(Range("A2:A65500"))
For I = 1 To say
Cells(I + 1, 1) = I
Next I

Düzenlenmiş hali;

[A2:A65536].ClearContents
Say = WorksheetFunction.CountA(Range("B2:B65536"))
For X = 2 To Say
If Cells(X,2)<>"" Then Cells(X, 1) = X
Next X

 

[ahmett46]

Hocam yine hata veriyor.Teşekkürler

 

[Skorpiyon]

..........

 

[Korhan Ayhan]

Selamlar,

Bu durumda örnek dosyanızı eklemenizi öneririm. Beraber kontrol edelim hata nerden kaynaklanıyor.

 

[ahmett46]

Dosya ektedir. Ayrıca İlgilendiğiniz için teşekkürler.

 

[ahmett46]

Yok mu dosyaya bakacak kimse

 

[Korhan Ayhan]

Selamlar,

Sanırım daha önce hazırlanış bir örnek dosyayı kendinize uyarlamaya çalışıyorsunuz.

Anladığım kadarıyla kodlarınızı aşağıdaki şekilde değiştirdim.

ListBox1_Click kodunuzu aşağıdaki ile değiştirin.

Private Sub ListBox1_Click()
    On Error Resume Next
    Set SATIR = [veri!B:B].Find(ListBox1, LookAt:=xlWhole)
    If Not SATIR Is Nothing Then
    Cells(SATIR.Row, 2).Select
    sil.Enabled = True
    degistirguncelle.Enabled = True
    kayıt.Enabled = False
    ComboBox2.SetFocus
    End If
End Sub

sil_Click kodunuza da aşağıdaki şekilde değiştirip denermisiniz.

Private Sub sil_Click()
    On Error Resume Next
    Sheets("veri").Select
    Set İSİM = ActiveCell
    If ActiveCell = "" Then
    MsgBox "Önce kaydını sileceğiniz kişiyi listeden seçmelisiniz."
    Exit Sub
    End If
    If MsgBox(İSİM & " isimli kişiye ait kayıt tamamen silinecek, silmek istiyor musunuz?", vbQuestion + vbYesNo, "Dikkat") = vbYes Then
    Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 16).Address(False, False)).Delete Shift:=xlUp
    [A2:A65536].ClearContents
    For x = 2 To [B65536].End(3).Row
    If Cells(x, 2) <> "" Then Cells(x, 1) = x - 1
    Next x
    
    MsgBox " " & &#304;S&#304;M & " isimli ki&#351;iye ait t&#252;m bilgiler silinmi&#351;tir.", vbInformation, "Sendika Program&#305;"
    formutemizle_Click
    ComboBox2_Change
    A.SetFocus
    Unload Personel
    Personel.Show
    Set &#304;S&#304;M = Nothing
    End If
End Sub

 

[ahmett46]

Teşekkürler Hocam

 

[ahmett46]

Hocam bi sorunumuz daha var. Bu kodlarla silme işlemi sorunsuz çalışıyor ancak listbox tan seçtiğimiz isme ait bilgiler ComboBox lara gelmiyor. Bunu nasıl gideririz.

 

[ahmett46]

Yardım lütfen

 

[ahmett46]

yokmu yardım edecek kimse