Otomatik sıra no vermede hızlı makro

[cemal42]

Aşağıdaki kod ile otomatik sıra no veriyorum. 8200 satır kayıt olunca kayıtta bekleme oluyor.
Bundan daha hızlı olarak otomatik sıra no makrosu var mı? Yardımlarınızı bekliyorum. Teşekkürler.

For sira = 3 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = sira - 2
Next

 

[Orion1]

Aşağıdaki kod ile otomatik sıra no veriyorum. 8200 satır kayıt olunca kayıtta bekleme oluyor.
Bundan daha hızlı olarak otomatik sıra no makrosu var mı? Yardımlarınızı bekliyorum. Teşekkürler.

For sira = 3 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = sira - 2
Next

aşağıdaki kodu deneyiniz.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For sira = 3 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = sira - 2
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

 

[uzmanamele]

Merhaba

Makro kaydet yöntemiyle uygun kodları elde edebilirsiniz.
Bunu deneyiniz.

Sub sırano()

    Range("a2") = "1"
    Range("a3") = "2"
    Range("a2:a3").Select
    Selection.AutoFill Destination:=Range("A2:A100")
End Sub

 

[Seyit Tiken]

Bu şekilde bir deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(ActiveCell, [B2:B10000]) Is Nothing Then Exit Sub
ActiveCell.Offset(-1, -1).Value = ActiveCell.Offset(-2, -1).Value + 1
End Sub

 

[mustafa1205]

Konu benim değil ama banada böyle bir çalışma lazımdı. Ancak çalışmama uygulayamadım. B1 Hücresine veri girişi yaptığımda a1 hücresine 1 sayısı olacak şekilde bunu aşağıya doğru yapmak istiyorum. Bunu nasıll yapabiliriz acaba?

 

[cemal42]

Kodlar için teşekkür ederim. İyi çalışmalar.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz.

Sub SIRA_NO_VER()
    Range("A3:A" & Rows.Count).ClearContents
    If Range("B3") <> "" Then
        Range("A3") = 1
        Range("A3:A" & Cells(Rows.Count, 2).End(3).Row).DataSeries _
        Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    End If
End Sub

 

[HASAN40]

Sayın Korhan Hocam,

Kodlarınızı farklı bir çalışmamda kullandım. Çok teşekkür ederim...