• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro İle Belirli Bir Tarihten önceki satırları kilitlemek

R

respecteams

Katılım
11 Ekim 2021
Mesajlar
19
Excel Vers. ve Dili
2013 vba
destek almak istiyorum
Merhaba Arkadaşlar,

Elimde Mikro Database'dan çekilmiş Personel Listesi var. Personellerin Geldi gelmedi izinli girdi çıktılarını yapıyorum.
İstediğim, personelin sigorta başlangıç tarihinden önceki tarih hücrelerinin o personel için kilitlenmesi/işlem yapılmaması.
Makro ile böyle bir kilitleme yapmam mümkün müdür? Mümkünse nasıl yapabilirim? Yardımcı olursanız çok sevinirim.
 
Bu arada excel kullanıyorum mikrodan sadece veri çektim yanlış anlaşılmasın
 
Merhaba,

Sorunuzun daha anlaşılır olması için örnek bir Excel dosyası hazırlayıp dosya içerisinde gerekli detaylı açıklamaları yapar mısınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.
dosya.co

.
 
Eklediğini dosyadaki personel listesi benzersiz bir liste. Bu listede ne olması gerekiyor. Detaylı açıklama yapmanızı rica etmiştim.
 
Bu liste personel devamsızlık listesi olacak. Personel isimlerinin yanında sigorta giriş tarihleri var ve tablonun geri kalanı üst tarafta 1 ay olacak şekilde tarihler yazıyor. Bana gereken her personel için, sigorta giriş tarihinden önceki günler tabloda kilitlenmeli.
 
Bu şekilde konuyu biliyormuşum gibi değil, örnek vererek detaylı açıklamanız gerekir.

Örneğin;
DAMLA AĞZIAÇIK ve DOĞUKAN ARMİŞEN için hangi hücrelerin(adreslerini de vererek) kilitlenmesi gerekiyor ve neden?
 
Ömer' Alıntı:
Bu şekilde konuyu biliyormuşum gibi değil, örnek vererek detaylı açıklamanız gerekir.

Örneğin;
DAMLA AĞZIAÇIK ve DOĞUKAN ARMİŞEN için hangi hücrelerin(adreslerini de vererek) kilitlenmesi gerekiyor ve neden?
Genişletmek için tıkla ...
Ben mikro database den excele personel isim listesi ve sigorta giriş tarihlerini aktardım. Otomatik olarak kendisini güncelliyor yeni personeller eklendikçe. Benim yapamadığım konu şu;
Personel listesi tablo şeklinde ve amacı devamsızlık listesi oluşturmak. Personellerin sigorta giriş tarihlerinden önceki günlerin o personel için kilitlenmesi/işlem yapılmaması gerekiyor. Bunu elle yapmak mümkün ama mikrodan tablo otomatik güncellendiğinden dolayı, makro kodlarıyla otomatik olarak yeni eklenen personelin sigorta tarihinden önceki günlerin kilitlenmesini hedefliyorum.
 
Sayfa koruma şifresini "+" olarak belirledim, siz kendinize göre değiştirirsiniz.
Kod: 
Sub kilitle()
   
    Dim i As Long, t1 As Date, s1 As Date, s2 As Date, son As Long, g1 As Byte
   
    s1 = DateSerial([A1], [B1], 1)
    s2 = WorksheetFunction.EoMonth(s1, 0)
    son = Cells(Rows.Count, "C").End(xlUp).Row
   
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "+"
   
    'With Range(Cells(4, "D"), Cells(Rows.Count, "AH"))
    With Cells
        .Locked = False
        .FormulaHidden = False
    End With

    For i = 4 To son
        t1 = DateSerial(Year(Cells(i, "C")), Month(Cells(i, "C")), 1)
        If t1 < s1 Then
            With Cells(i, "D").Resize(1, 31)
                .Locked = True
                .FormulaHidden = True
            End With
        End If
        If t1 >= s1 And t1 <= s2 Then
            g1 = Day(Cells(i, "C"))
            If g1 <> 1 Then
                With Range(Cells(i, "D"), Cells(i, g1 + 3))
                    .Locked = True
                    .FormulaHidden = True
                End With
            End If
        End If
    Next i
   
    ActiveSheet.Protect "+"
    Application.ScreenUpdating = True
   
End Sub
 
Ömer' Alıntı:
Sayfa koruma şifresini "+" olarak belirledim, siz kendinize göre değiştirirsiniz.
Kod: 
Sub kilitle()
  
    Dim i As Long, t1 As Date, s1 As Date, s2 As Date, son As Long, g1 As Byte
  
    s1 = DateSerial([A1], [B1], 1)
    s2 = WorksheetFunction.EoMonth(s1, 0)
    son = Cells(Rows.Count, "C").End(xlUp).Row
  
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "+"
  
    'With Range(Cells(4, "D"), Cells(Rows.Count, "AH"))
    With Cells
        .Locked = False
        .FormulaHidden = False
    End With

    For i = 4 To son
        t1 = DateSerial(Year(Cells(i, "C")), Month(Cells(i, "C")), 1)
        If t1 < s1 Then
            With Cells(i, "D").Resize(1, 31)
                .Locked = True
                .FormulaHidden = True
            End With
        End If
        If t1 >= s1 And t1 <= s2 Then
            g1 = Day(Cells(i, "C"))
            If g1 <> 1 Then
                With Range(Cells(i, "D"), Cells(i, g1 + 3))
                    .Locked = True
                    .FormulaHidden = True
                End With
            End If
        End If
    Next i
  
    ActiveSheet.Protect "+"
    Application.ScreenUpdating = True
  
End Sub
Genişletmek için tıkla ...
teşekkürler, kod hata vermiyor ama sigorta tarihlerinden önceki günlerle oynayabiliyorum?. Makroyu yapıştırdıktan sonra başka bir işlem yapmam gerekiyor mu ve ikinci attığım dosya için mi oluşturdunuz?
 
Kodları module ekledikten sonra çalıştırdınız mı?

Eki inceleyiniz. Kilitle butonuna bastıktan sonra deneyiniz.
Eğer aynı giriş gününe de hücre girişine izin verecekse kodlardaki; Cells(i, g1 + 3) bu bölümdeki +3 ü +2 olarak değiştirirsiniz.


İndir Kitap2 Kopya

Dosyayı indir Kitap2 Kopya
dosya.co


.
 

Ekli dosyalar

Ömer' Alıntı:
Kodları module ekledikten sonra çalıştırdınız mı?

Eki inceleyiniz. Kilitle butonuna bastıktan sonra deneyiniz.
Eğer aynı giriş gününe de hücre girişine izin verecekse kodlardaki; Cells(i, g1 + 3) bu bölümdeki +3 ü +2 olarak değiştirirsiniz.


İndir Kitap2 Kopya

Dosyayı indir Kitap2 Kopya
dosya.co


.
Genişletmek için tıkla ...
Teşekkürler fakat şuanda da hiçbir sutüna izin vermiyor. Giriş tarihlerinden sonraki günler değiştirilebilir olmalı ya da öyle ayarladıysanız nerede hata yapıyorum çözemedim. Kilitle tuşuna bastıktan sonra da aynı şekil
 
Ömer' Alıntı:
Kodları module ekledikten sonra çalıştırdınız mı?

Eki inceleyiniz. Kilitle butonuna bastıktan sonra deneyiniz.
Eğer aynı giriş gününe de hücre girişine izin verecekse kodlardaki; Cells(i, g1 + 3) bu bölümdeki +3 ü +2 olarak değiştirirsiniz.


İndir Kitap2 Kopya

Dosyayı indir Kitap2 Kopya
dosya.co


.
Genişletmek için tıkla ...
misal tekin çakırda olması gerektiği gibi ama doğukan da kilitli diyor.. acaba bir yerde çakışıyor mudur
 
Doğukan 01.04.2021 de girmiş. Sizin A1 ve B1 deki verilere göre ölçütünüz Ekim.2021 bu durumda Ekim tablosunda Doğukan için veri girişine izin vermiyor.
Kurgu hatalı mı?
 
Birde aşağıdaki gibi deneyiniz. Sanırım istediğiniz bu. Eski kodları silip aşağıdakileri aynı bölüme yapıştırıp buton ile çalıştırın.
Kod: 
Sub kilitle()
  
    Dim i As Long, t1 As Date, s1 As Date, s2 As Date, son As Long, g1 As Byte
  
    s1 = DateSerial([A1], [B1], 1)
    s2 = WorksheetFunction.EoMonth(s1, 0)
    son = Cells(Rows.Count, "C").End(xlUp).Row
  
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "+"
  
    'With Range(Cells(4, "D"), Cells(Rows.Count, "AH"))
    With Cells
        .Locked = False
        .FormulaHidden = False
    End With

    For i = 4 To son
        t1 = DateSerial(Year(Cells(i, "C")), Month(Cells(i, "C")), 1)
        'If t1 < s1 Then
        '   With Cells(i, "D").Resize(1, 31)
        '      .Locked = True
        '        .FormulaHidden = True
        '    End With
        'End If
        If t1 >= s1 And t1 <= s2 Then
            g1 = Day(Cells(i, "C"))
            If g1 <> 1 Then
                With Range(Cells(i, "D"), Cells(i, g1 + 2))
                    .Locked = True
                    .FormulaHidden = True
                End With
            End If
        End If
    Next i
  
    ActiveSheet.Protect "+"
    Application.ScreenUpdating = True
  
End Sub
 
Kurguyu kontrol ettim, fixlenecek bug yok. Düzenlediğiniz kodu deneyip tekrar yazacağım, ilgi ve alakanız için tekrar teşekkür ediyorum şuanda hayatımı kurtarıyorsunuz
 
Ömer' Alıntı:
Birde aşağıdaki gibi deneyiniz. Sanırım istediğiniz bu. Eski kodları silip aşağıdakileri aynı bölüme yapıştırıp buton ile çalıştırın.
Kod: 
Sub kilitle()
  
    Dim i As Long, t1 As Date, s1 As Date, s2 As Date, son As Long, g1 As Byte
  
    s1 = DateSerial([A1], [B1], 1)
    s2 = WorksheetFunction.EoMonth(s1, 0)
    son = Cells(Rows.Count, "C").End(xlUp).Row
  
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "+"
  
    'With Range(Cells(4, "D"), Cells(Rows.Count, "AH"))
    With Cells
        .Locked = False
        .FormulaHidden = False
    End With

    For i = 4 To son
        t1 = DateSerial(Year(Cells(i, "C")), Month(Cells(i, "C")), 1)
        'If t1 < s1 Then
        '   With Cells(i, "D").Resize(1, 31)
        '      .Locked = True
        '        .FormulaHidden = True
        '    End With
        'End If
        If t1 >= s1 And t1 <= s2 Then
            g1 = Day(Cells(i, "C"))
            If g1 <> 1 Then
                With Range(Cells(i, "D"), Cells(i, g1 + 2))
                    .Locked = True
                    .FormulaHidden = True
                End With
            End If
        End If
    Next i
  
    ActiveSheet.Protect "+"
    Application.ScreenUpdating = True
  
End Sub
Genişletmek için tıkla ...
yeni kodlarınızla denedim, aynı hata devam ediyor. misal ŞABAN GÖKTEPE de olması gerektiği gibi ama pek çoğunda değil.
 
Doğru sonuçlanmayan 3-4 isim yazar mısınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst