Sıra numarası hk.

Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Altın Üyelik Bitiş Tarihi
27-04-2022
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
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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.
 
Son düzenleme:
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Altın Üyelik Bitiş Tarihi
27-04-2022
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.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Dosyanızda öyle bir sorun göremedim. Tam olarak nereye, nereden, neyi kopyaladığınızda böyle bir sorun oluyor?
 
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Altın Üyelik Bitiş Tarihi
27-04-2022
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

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin:

PHP:
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
 
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Altın Üyelik Bitiş Tarihi
27-04-2022
Allah binkere razı olsun. Çok teşekkür ederim.
 
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Altın Üyelik Bitiş Tarihi
27-04-2022
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

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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:

PHP:
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 ;)
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Son şekli ile dosyayı ekleme imkanınız var mı acaba? Teşekkür ederim.
 
Üst