Tablo Başlığına Artan Numaralar eklemek

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,
ekte görüldüğü üzere bir çalışma sayfam var. Tabloların üzerine 103'ten başlamak üzere 103-104-105 şeklinde numaralar vermek istiyorum. Soldan sağa doğru devam ediyor tablolarım. dosyam ektedir. Yardımcı olabilir misiniz ?
220452
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod:
Sub Numara_Ver()

    Dim sut As Integer, s As Integer, i As Integer
    
    sut = Cells(2, Columns.Count).End(xlToLeft).Column
    s = 103
    
    Rows(1) = ""
    For i = 1 To sut Step 10
        Cells(1, i) = s
        s = s + 1
    Next i
    
End Sub
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,

Deneyiniz.
Kod:
Sub Numara_Ver()

    Dim sut As Integer, s As Integer, i As Integer
   
    sut = Cells(2, Columns.Count).End(xlToLeft).Column
    s = 103
   
    Rows(1) = ""
    For i = 1 To sut Step 10
        Cells(1, i) = s
        s = s + 1
    Next i
   
End Sub
Ömer bey sadece ilk sıradaki tablolara numara verdi, dosyadaki tüm tablolara numara vermek istiyorum. Soldan sağa devam edecek. her sırada 4 tablo var. 103-104-105-106' dan sonra alt sıradaki tabloya geçip 107-108 diye devam etmesini istiyorum. Mümkün müdür ?
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Aşağıdaki tabloları görmemişim.

Tabloların hepsi aynı satır ve sütun sayılı sanırım.
Kod:
Sub Numara_Ver()

    Dim sut As Integer, sat As Long, s As Long, i As Integer, j As Long
   
    sat = Cells(Rows.Count, "B").End(xlUp).Row
    s = 103

    For j = 1 To sat Step 15
        Rows(j) = ""
        sut = Cells(j + 1, Columns.Count).End(xlToLeft).Column
        For i = 1 To sut Step 10
            Cells(j, i) = s
            s = s + 1
        Next i
    Next j
   
End Sub
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
teşekkür ederim,elinize sağlık
 
Üst