Makro ile örneğe uygun kopyalama (bir çeşit koşullu biçimlendirme)

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Tablo 1; 50 farklı özelliği olan sütundan oluşuyor (bazıları aynı özelliğe sahip A-C , B-C , C-C , D-C , … gibi)
Tablo 2; her kolon, ayın günlerini sırayla gösteriyor (bu kısaltılmış örnek tablo) (ayın gün sayısına bağlı olarak 29 - 32 kolon olabiliyor, isimle birlikte)
Her kişi için 3 satır ayrılmış
3. satırın özellikleri 2. satırın aynı (bazı durumlar hariç) (T15:T17 , W9:W11 , … gibi)
T15:T17 ==> AD15:AD17 iptal edilmiş, X12:X14 ==> AH12:AH14 boş gün, … gibi
Tablo 3; Tablo 2 de her kişi için, birinci satırda olanları Tablo 1 den üç satır olarak alır getirir Tablo 3 te aynı konuma kopyalar
Saygılarımla

 

[Asri]

Hocam,

çözüme ulaşılmasını hızlandırması açısından aşağıdaki soruları cevaplar mısınız?

Öncelikle verdiğiniz kolon isimlerinden dolayı her iki tabloda kolonların bir tane sağa kaydığını düşünüyorum.

* Tablo1 de 3 satır sabit midir. 3 er 3 er artmaktamıdır?
* Tablo2 de 1. satır lar ve 1. kolon sabit midir? Bu veriler biri tarafından giriş yapılan veriler midir?

* Tablo2 tamamen biri tarafından doldurulmakta, sadece Tablo1 e göre biçimlendirme mi istenmektedir.

 

[Tevfik_Kursun]

Sayın Asri Hocam,
İlginize çok teşekkür ederim.
Smltr sayfasında mavi renkli hücrelere Bilgi sayfasındaki sayılardan yazıldığında altındaki üç hücrenin bu tarafa kopyalanmasını istiyorum. Şu anda fonksiyon ile gelenlerin renk ve özellikleri ile Bilgi sayfasından gelmesini istiyorum.
Bu benim işimi görür.
Saygılarımla

 

[Asri]

Sayın Asri Hocam,
İlginize çok teşekkür ederim.
Smltr sayfasında mavi renkli hücrelere Bilgi sayfasındaki sayılardan yazıldığında altındaki üç hücrenin bu tarafa kopyalanmasını istiyorum. Şu anda fonksiyon ile gelenlerin renk ve özellikleri ile Bilgi sayfasından gelmesini istiyorum.
Bu benim işimi görür.
Saygılarımla

Çok düzenli bir kod olmadı ama iş görecektir.
Smltr sayfasının kod bölümüne kopyalayınız.

Olur da kod yarım kalır devam etmez ise, sayfa değişiklikleri algılamayabilir. Bu durumda "degisime_tepki_vermez_ise" prosedürünü bir defa çalıştırın.

Sebebi kod içinde Application.EnableEvents = False kullanımından kaynaklanmaktadır.

Mavi alanlara 1,2,3,4 yazarak deneyiniz. Değer yazan yerdeki formülleri silinecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Value <= 0 And Target.Value > 30 Then Exit Sub
  On Error GoTo son
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  sayi = Target.Value + 22
  satir = Target.Row
  sutun = Target.Value + 36
  
  Cells(satir + 3, sutun).Value = Sheets("Bilgi").Cells(12, sayi).Value
  Cells(satir + 4, sutun).Value = Sheets("Bilgi").Cells(13, sayi).Value
  Cells(satir + 5, sutun).Value = Sheets("Bilgi").Cells(14, sayi).Value
   
  With Range(Cells(satir + 3, sutun), Cells(satir + 5, sutun))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .NumberFormat = "hh:mm;@"
        .Interior.Color = Sheets("Bilgi").Cells(13, sayi).Interior.Color
        .Font.Size = Sheets("Bilgi").Cells(13, sayi).Font.Size
        .Font.Color = Sheets("Bilgi").Cells(13, sayi).Font.Color
        .Font.Bold = True
    End With
    
    With Cells(satir + 3, sutun)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .NumberFormat = "hh:mm;@"
        .Interior.Color = Sheets("Bilgi").Cells(12, sayi).Interior.Color
        .Font.Size = Sheets("Bilgi").Cells(12, sayi).Font.Size
        .Font.Color = Sheets("Bilgi").Cells(12, sayi).Font.Color
        .Font.Bold = True
    End With

son:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

Sub degisime_tepki_vermez_ise()
  Application.EnableEvents = True
End Sub

 

[Tevfik_Kursun]

Merhaba Sayın Asri Hocam,
İlginize çok teşekkür ederim. Mavi hücrelere yazılan sayının karşılıklarının yazılan hücrenin altındaki üç hücreye gelmesi gerekirken yazılan sayının 5 fazlasının olduğu hücrenin altına gidiyor. Ayrıca aylar 31, 30, 29 yada 28 gün olabilir.
Ben de bir çalışma hazırladım. Doğru kopyalıyor ama özelliklerini getiremiyor. Sanırım bir yerde hata yapmışım.
İsterseniz incelemeniz için yaptığımı gönderebilirim.
Saygılarımla

 

[Asri]

yazılan sayının 5 fazlasının olduğu hücrenin altına gidiyor.

Bu sorun değil, kodda satir+3 4,5 değerlerini 1,2,3 yada 2,3,4 olarak değiştirin. İstediğiniz satıra yazdırmış olursunuz.

Ayrıca aylar 31, 30, 29 yada 28 gün olabilir.

Programı hangi sayıyı yazdıysanız onun kolon olarak karşılığını getirir.
Yani 1 yazdıysanız , bilgi sayfasından 22+1 kolondaki değeri getirir.
2 yazdıysanız , bilgi sayfasından 22+2 kolondaki değeri getirir.

Bu şekilde 30 yazdıysanız bilgi sayfasında 22+30 uncu kolondaki bilgiyi alır.

Ben de bir çalışma hazırladım. Doğru kopyalıyor ama özelliklerini getiremiyor. Sanırım bir yerde hata yapmışım.
İsterseniz incelemeniz için yaptığımı gönderebilirim.

Tabikii, gönderiniz.

Ancak, yukarıdaki açıklamaları kontrol ediniz.