Belirli satıra getirmek

[1903emre34@gmail.com]

Merhaba,

Ekrandaki gibi, TOPLAM YAZISIYLA beraber yandaki formülle kurgusuyla birlikte 60.000 satıra getirmek istiyorum, nasıl kod oluşturabiliriz

 

[netzone]

Merhaba,

Ekrandaki gibi, TOPLAM YAZISIYLA beraber yandaki formülle kurgusuyla birlikte 60.000 satıra getirmek istiyorum, nasıl kod oluşturabiliriz

Ekli dosyayı görüntüle 261366

Merhaba,

Bu tablonuzda görüldüğü üzere ilerleyen zamanlarda bu satır sayısı değişkenlik gösterebilecektir.
F sütununuzda son dolu olan satırı 60.000. satıra taşıyarak Tablonuzda yer alan toplam satırını öteleyebilirsiniz.

*Kodlar yapay zeka tarafından oluşturulmuş, tarafımca toplam satırını aktif ettiğim TABLO üzerinde denenmiştir.

İyi çalışmalar.

Sub SonSatiriAltmisBineOtele()
    Dim sonSatir As Long
    Dim hedefSatir As Long
    Dim eklenecekAdet As Long
    
    hedefSatir = 60000
    
    ' F sütunundaki (6. sütun) en son dolu satırı bulur
    sonSatir = Cells(Rows.Count, "F").End(xlUp).Row
    
    ' Eğer son satır zaten 60.000 veya daha aşağıdaysa işlem yapmaz
    If sonSatir >= hedefSatir Then
        MsgBox "F sütunundaki son satır (" & sonSatir & ") zaten hedef satıra ulaştı veya geçti.", vbExclamation
        Exit Sub
    End If
    
    eklenecekAdet = hedefSatir - sonSatir
    
    Application.ScreenUpdating = False
    
    ' Son dolu satırın hemen üstüne boş satırlar ekleyerek onu 60.000'e iter
    ' Bu işlem aradaki formül referanslarını (TOPLA gibi) otomatik genişletir
    Rows(sonSatir & ":" & sonSatir + eklenecekAdet - 1).Insert Shift:=xlDown
    
    Application.ScreenUpdating = True
    
    MsgBox "F sütunundaki son veri (" & sonSatir & ". satırdaki), " & hedefSatir & ". satıra ötelendi.", vbInformation
End Sub

 

[1903emre34@gmail.com]

Teşekkürler, kalın cizgi yapmak için değişiklik yapabilir miyiz

 

[netzone]

Merhaba,

Şablonunuzda alt ve üst çizgiler var ise öteleme yapıldığında bu biçimlendirme bozulmaması gerekiyor.

Bir şekilde bozulduğunu yada olmadığını düşünürsek; öteleme yapıldıktan sonra Application.ScreenUpdating=True öncesine aşağıdaki kodu yapıştırıp deneyiniz.

' --- KENARLIK EKLEME BÖLÜMÜ ---
    ' Artık verimiz 60.000. satırda (hedefSatir)
    With Rows(hedefSatir).Borders(xlEdgeTop) ' Üst Kenarlık
        .LineStyle = xlContinuous
        .Weight = xlThick ' Kalın
        .ColorIndex = xlAutomatic
    End With
   
    With Rows(hedefSatir).Borders(xlEdgeBottom) ' Alt Kenarlık
        .LineStyle = xlContinuous
        .Weight = xlThick ' Kalın
        .ColorIndex = xlAutomatic
    End With
    ' ------------------------------

Komple satıra değilde örn. A:Z sütun aralığına uygulayacaksanız, bu kodu kullanın.

İyi çalışmalar.

' --- KENARLIK EKLEME BÖLÜMÜ (A:Z Arası) ---
    ' 60.000. satırdaki A ve Z sütunları arasını tanımlıyoruz
    Set hedefAralik = Range("A" & hedefSatir & ":Z" & hedefSatir)
   
    ' Üst Kenarlık
    With hedefAralik.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
   
    ' Alt Kenarlık
    With hedefAralik.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    ' ------------------------------------------