Çalışma Kitabında Koruma Altındaki Hücrelerin Adreslerini Yaz

[baydeniro]

Merhaba arkadaşlar. Makro kodu ile çalışma kitabı içindeki tüm sayfalarda KORUMALI HÜCRELERİN adreslerini hücreler yazdırmak mümkün mü ?

 

[Muzaffer Ali]

Adreslerin hangi hücreye yazılacağını yazmamışsınız. Aşağıdaki kodlar mesaj ile adresi veriyor.

Sub HucreKorumalimi()
    Dim Satir As Long
    Dim Sutun As Integer
    
    For Satir = 1 To Rows.Count
        For Sutun = 1 To Columns.Count
            If Cells(Satir, Sutun).Locked = True Then
                MsgBox Cells(Satir, Sutun).Address
            End If
        Next
    Next
End Sub

 

[baydeniro]

Merhaba dalgalikur, teşekkür ediyorum. A1 hücresinden aşağıya doğru yazılması şeklinde revize edebilir misin acaba !

 

[Muzaffer Ali]

Sub HucreKorumalimi()
    Dim Satir As Long
    Dim Sutun As Integer
    Dim YazSatir As Long
    Dim YazSutun As Integer
    YazSutun = 1
    
    
    For Sutun = 1 To Columns.Count
        For Satir = 1 To Rows.Count
            If Cells(Satir, Sutun).Locked = True Then
                YazSatir = YazSatir + 1
                Cells(YazSatir, YazSutun).Value = Cells(Satir, Sutun).Address
                If YazSatir = Rows.Count Then
                    YazSatir = 0
                    YazSutun = YazSutun + 1
                End If
            End If
        Next
    Next
    MsgBox "İşlem tamamlandı..."
End Sub

 

[baydeniro]

dalgalikur yardım için çok teşekkür ediyorum. Tüm sayfa korumalı iken yazıyor ama hepsinin koruması açık, birkaç hücre korumalı iken birşey yazmayıp döngüye giriyor,

 

[Muzaffer Ali]

Excel sayfasında 1.048.576 satır 16.384 sütun var
1.048.576 * 16.384 = 17.179.869.184 kere döngü devam edecek ve her hücreyi tek tek kontrol edecek bittiğinde mesaj verecektir. Bu sebepten ötürü işlemin bitmesi çok uzun zaman alır.

eğer belli bir bir aralığı kontrol etmek istersen daha kısa sürer mesela 100 satır ve 10 kolon kontrol etmek istersen aşağıdaki kodları kullan.

Sub HucreKorumalimi()
    Dim Satir As Long
    Dim Sutun As Integer
    Dim YazSatir As Long
    Dim YazSutun As Integer
    YazSutun = 1
    
    Dim KacKolonaBaksin As Integer
    Dim KacSatiraBaksin As Integer
    
    KacKolonaBaksin = 10 '10 sütun kontrol etsin
    KacSatiraBaksin = 100 '100 Satır kontrol etsin
    
    For Sutun = 1 To KacKolonaBaksin
        For Satir = 1 To KacSatiraBaksin
            If Cells(Satir, Sutun).Locked = True Then
                YazSatir = YazSatir + 1
                Cells(YazSatir, YazSutun).Value = Cells(Satir, Sutun).Address
                If YazSatir = Rows.Count Then
                    YazSatir = 0
                    YazSutun = YazSutun + 1
                End If
            End If
        Next
    Next
    MsgBox "İşlem tamamlandı..."
End Sub

 

[baydeniro]

çok teşekkürler dalgalikur. Hücre adreslerini bulunduğu sayfa adını da içerecek şekilde yazılabilir mi ?

 

[dEdE]

çok teşekkürler dalgalikur. Hücre adreslerini bulunduğu sayfa adını da içerecek şekilde yazılabilir mi ?

Merhaba,
Araya giriyorum ama, kodu aşağıdaki gibi değiştirip dener misiniz?

Sub HucreKorumalimi()
s = 1
KacKolonaBaksin = 10 '10 sütun kontrol etsin
KacSatiraBaksin = 100 '100 Satır kontrol etsin
For i = 1 To Sheets.Count
    For Sutun = 1 To KacKolonaBaksin
        For Satir = 1 To KacSatiraBaksin
            If Sheets(i).Cells(Satir, Sutun).Locked = True Then
                Cells(s, 2).Value = Cells(Satir, Sutun).Address
                Cells(s, 1).Value = Sheets(i).Name
                s = s + 1
            End If
        Next
    Next
Next i
    MsgBox " İşlem Tamamlandı. ", vbInformation, "dEdE  " & _
    Application.UserName & "'e Başarılar Diler."
End Sub

 

[baydeniro]

Sayın dalgalikur, yardımlarınız için çok teşekkür ediyorum, çok makbule geçti, esen kalın

 

[baydeniro]

sayon dEdE, çok iyi bir alternatif kod oldu, elinize sağlık, sağlıcakla kalın