Sıra numarası hk.

[reosman]

Saygıdeğer arkadaşlar,
Aşağıdaki şekilde sıra numarası verme kodum var ve çalışıyor.
Fakat kopyala - yapıştır yaptığımda sıra numarası vermiyor ve ilk üç sütunu siliyor.
Bu hususta yardımınızı rica ediyorum.

Private Sub Worksheet_Change(ByVal target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(target, Range("B2:B1048576")) Is Nothing Then Exit Sub
If target = "" Then
target.Offset(0, -1) = ""
Else
If target.Offset(0, -1) = "" Then
target.Offset(0, -1) = WorksheetFunction.Max(Range("A2:A1048576")) + 1
End If
End If
End Sub

 

[reosman]

Güncel

 

[YUSUF44]

Verdiğiniz kodda sütun silmeye ilgili bir komut göremedim. Dosyanızdaki başka kodlar buna sebep olabilir.

İkinci olarak kodunuzda B sütunundaki değişikliğe bağlı olarak yine B sütununda işlem yaptırıyorsanız, bu işlem kısır döngüye sebep olabilir. Böyle durumlarda işlem yaptırmadan önce

ApplicationEnableEvents=False

Ve sonra da

ApplicationEnableEvents=True

Satırlarını kullanmanızı tavsiye ederim.

 

[reosman]

Yusuf hocam sadece kopyala yapıştırda sıra numarası vermiyor ve b,c,d satırlarını siliyor.
Normal elle girince sıra numarasını veriyor. Size zahmet olacak bir bakarsanız. Hakkınızı helal edin sizi çok yordum.

 

[YUSUF44]

Dosyanızda öyle bir sorun göremedim. Tam olarak nereye, nereden, neyi kopyaladığınızda böyle bir sorun oluyor?

 

[reosman]

sıra numarası hariç diğer kısımları toplu olarak mesela 5-10 satır başka yerden veya aynı sayfadan kopyala yapıştır yapınca sıra numarası vermiyor ama elle tek tek girişte B sütununa giriş yapıldığında otomatik sıra numarasını veriyor. Sadece kopyala yapıştırda sıra numarası vermiyor.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Private Sub Worksheet_Change(ByVal target As Range) 'KAYIT SIRASI VERME

If Intersect(target, Range("B2:B1048576")) Is Nothing Then Exit Sub
Dim a, say, i As Integer
Application.ScreenUpdating = False
If Selection.Count > 1 Then
    a = Selection.Row
    say = Selection.Rows.Count
    For i = a To a + say - 1
        Cells(i, "A") = i - 1
    Next
ElseIf target = "" Then
    target.Offset(0, -1) = ""
Else
    target.Offset(0, -1) = target.Row - 1
End If
Application.ScreenUpdating = True
End Sub

 

[reosman]

Allah binkere razı olsun. Çok teşekkür ederim.

 

[reosman]

Yusuf bey lütfen hakkınızı helal edin. Kopyala yapıştır yaptıktan sonra sıra numarasını veriyor bu kısımda sıkıntı yok şimdide şu şekilde bir problemim oluştu, örneğin 5-10 satır kopyala yapıştır yapıyorum sıra numarasını veriyor toplama işlemini yapmıyor ancak son boş B hücresine herhangibirşey yazarsanız toplamayı yapıyor ve sıra numarası hariç diğer kısımları toplu silince sıra numaraları satırlarda kalıyor.

 

[YUSUF44]

Gördüğünüz üzere böyle parça parça anlatınca sizin aklınızdakileri bilmediğimizden bir yeri düzeltirken başka yeri bozuyoruz ya da düzeltemiyoruz.

Nereye neyi toplaması gerekiyor?

Silme için aşağıdaki kodu deneyin:

Private Sub Worksheet_Change(ByVal target As Range) 'KAYIT SIRASI VERME

If Intersect(target, Range("B2:B1048576")) Is Nothing Then Exit Sub
Dim a, say, i, son As Integer
Application.ScreenUpdating = False
If Selection.Count > 1 Then
    a = Selection.Row
    say = Selection.Rows.Count
    For i = a To a + say - 1
        Cells(i, "A") = i - 1
    Next
ElseIf target = "" Then
    target.Offset(0, -1) = ""
Else
    target.Offset(0, -1) = target.Row - 1
End If
son = Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountBlank(Range("B1:B" & son)) > 0 Then
    Range("B1:B" & son).SpecialCells(xlCellTypeBlanks).Offset(0, -1).ClearContents
End If
Range("A" & son + 1 & ":A" & Rows.Count).ClearContents

Application.ScreenUpdating = True
End Sub

Bir de soru sorarken daha önce bahsetmediğiniz dolayısıyla bizim bilmemizin imkanı olmayan konular hakkında "olmuyor, kalıyor" vs demezseniz iyi olur

 

[reosman]

Eywallah Yusuf bey.

 

[yyhy]

Son şekli ile dosyayı ekleme imkanınız var mı acaba? Teşekkür ederim.