Excel VBA otomatik sıra namarası güncelleme sorunu

[karabulutfatih]

Arkadaşlar koay gelsin.

Option Explicit
Public EnableEvents As Boolean


Private Sub btnAdd_Click()
Dim x As Byte
Dim lastRow As Long
Dim nextID As Long

'B sütunundaki verilerin bulunduğu son satırı bulun
lastRow = Sheets("Record").Cells(Sheets("Record").Rows.count, "B").End(xlUp).Row

x = MsgBox("Do you want to add staff?", vbYesNo + vbDefaultButton1 + vbQuestion, "ADD")

'---Verileri doğrula--------------------
Dim isValid As Boolean
isValid = ValidatePrintDetails()
If isValid Then

If x = 7 Then Exit Sub

' Bir sonraki kullanılabilir satırı belirle
nextID = Application.WorksheetFunction.CountA(Sheets("Record").Columns("B")) + 1

' Tarih girişini doğrulama ve biçimlendirme

' Yeni satırı en sona ekle
With Sheets("Record")
.Cells(nextID, "B").Value = txtEmpName.Value
.Cells(nextID, "C").Value = txtEmpId.Value
.Cells(nextID, "D").Value = cbWorkingSchool.Value
.Cells(nextID, "E").Value = txtStartDay.Value & "." & txtStartMonth.Value & "." & txtStartYear.Value
.Cells(nextID, "F").Value = cbStatus.Value
.Cells(nextID, "G").Value = cbStaffTitle.Value
.Cells(nextID, "H").Value = cbTeachingCareerStep.Value
.Cells(nextID, "I").Value = cbMission.Value
.Cells(nextID, "J").Value = cbBranch.Value
.Cells(nextID, "K").Value = cbStaffStatus.Value
.Cells(nextID, "L").Value = cbGender.Value
.Cells(nextID, "M").Value = cbShelfNo.Value

.Cells(nextID, "N").Value = Application.UserName
.Cells(nextID, "O").Value = Format(Now, "DD-MM-YYYY HH:MM")

.Cells(nextID, "A").Value = nextID - 1
End With

LoginSaveYourMovement

PersonelListesi

UpdateTotalStaffNumber

Call Reset

PersonelListesi

' Başarı mesajını göster
MsgBox "Staff Successfully Added!..", vbInformation, "SUCCESS"
End If

End Sub


Private Sub btnDelete_Click()
Dim x As Byte
Dim y As Long

x = MsgBox("Kayıt Silinsin mi?", vbYesNo + vbDefaultButton2 + vbCritical, "SİL")
If x = 7 Then Exit Sub
For y = 2 To 500000
If Sheets("Record").Range("B" & y).Value = "" Then Exit For
If Trim(Sheets("Record").Range("B" & y).Value) = Trim(txtEmpName.Value) Then

Sheets("Record").Rows(y & ":" & y).Delete

' Sıra numaralarını güncelle
Dim i As Long
Dim lastRow As Long
lastRow = Sheets("Record").Cells(Sheets("Record").Rows.count, 1).End(xlUp).Row

' Silinen satır sonrasındaki satırların sıra numaralarını bir azalt
For i = y To lastRow
Sheets("Record").Cells(i, 1).Value = i - 1
Next i

MsgBox "Kayıt Başarıyla Silindi"

Call Reset
Exit Sub
End If
Next
End Sub


Offci 365 öğrenci sürümü ile VBA da oluştuduğum personel kayıt ve takip programı yapıyorum. "btnAdd" butonu ile Record sayfasındaki tablo formatındaki belirtilen aralığa yeni kaydı ilk boş satır olan "A2" den başlayarak ekliyorum ve sonucunda da otomatik sıra numarası ekleniyor. "btnDelete" ile "A2" satırında kalan "1" sıra numaralı son kaydı silmek istediğimde tüm satırdaki bilgileri silmesine rağmen sıra numarasını silmiyor. Yüzlerce kayıt ekliyorum. Hepsini sildikten sonra sıra numaralarını otomatik güncelliyor ama "A2" satırını sildikten sonra buradaki "1" sıra umarasını silmiyor. Programın bitime geldim sayılır. Aslında ilk başlarda defalarca deneyerek bu aşamaya geldim ve böyle bir sorun yoktu ama programa güncelleme geldi diye böyle bir sorun oldu bilemiyorum. Çünkü onlarca yedeğim var bunların hiç birisinde bu sorun yokken şimdi hepsinde aynı sournla karışılaşıyorum.
"A2" satırındaki 1 sıra numarası silinmeyince de "btnAdd" ile yeni kayıt eklerken program hata veriyor ve kapanıyor. Ne yaptıysam da bu sorunu çözemedim. Yardımcı olabilirseniz memnun olurum

 

[ÖmerFaruk]

For i = y To lastRow
Sheets("Record").Cells(i, 1).Value = i - 1
Next i

Sanırım buradaki döngüden dolayı.
Lastrow 1 oluyor. Y değişkeni 2 de kalıyor. For Next çalışmıyor

 

[karabulutfatih]

Evet, bahsettiğiniz kısımdan kaynaklı görünüyor. Bu kodu kaldırdığımda "A2" hücresindeki sıra numarasını siliyor ama ama bu kez de sıra numaraları otomatik güncellenmiyor

 

[ÖmerFaruk]

Lastrow >1 sorgusu yapıp For next döngüsünü öyle çalıştırısanız olur.

 

[karabulutfatih]

örneği yazma şansınız var mı? tam anlayamadım

 

[ÖmerFaruk]

.....
    .........
    if lastRow>=y then
        For i = y To lastRow
            Sheets("Record").Cells(i, 1).Value = i - 1
        Next i
    End if
.....
        ........

 

[karabulutfatih]

Teşekkürler arkadaşlar. Sayfa kodunun içine aşağıdaki gibi bir kod ekleyerek sorunu çözdüm.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As Long
If Intersect(Target, Range("b2:b65536")) Is Nothing Then Exit Sub
For i = 2 To Range("b65536").End(3).Row
If Cells(i, 2).Value = "" Then
Cells(i, 1).Value = ""
Else
s = s + 1
Cells(i, 1).Value = s
End If
Next i
End Sub