Soru Başka bir sayfadan veri ile beraber biçimlendirmeleri de aktarma

M

mustafa

Altın Üye
Katılım
8 Eylül 2004
Mesajlar
263
Excel Vers. ve Dili
Excel 365 - Türkçe
Merhabalar,

Basketbol sayfasında bir takımı seçip TAKIM SEÇ butonuna tıkladığımda o satırdaki takımlar Ana Sayfa E2 ve F2 hücrelerine aktarılıyor. Sonra Ana Sayfada MAÇLARI GETİR butonuna tıkladığımda E2 ve F2 hücrelerindeki takımların son oynadıkları maçlar aktarılıyor. Buraya kadar sorun yok, ben maçlar aktarılırken Basketbol sayfasındaki biçimlendirmelerin de aktarılmasını istiyorum.

Yardımcı olacak ustalara şimdiden teşekkür ederim.

İnternete baktım fakat bu anlamda bir soru ve çözüm göremedim.

Eğer bu mümkün değilse Basketbol sayfasındaki aşağıdaki kod renklendirme (biçimlendirme) yapıyor. Bu kodu Ana Sayfaya uygulanmasını istiyorum.

Kod: 
''''Renklendirmeler sıfırlanıyor
                    Cells(sat, 10).Interior.ColorIndex = xlNo
                    Range("K" & sat & ":R" & sat).Interior.ColorIndex = 19
                    Range("S" & sat & ":T" & sat).Interior.ColorIndex = xlNo
                    Cells(sat, 21).Interior.ColorIndex = 6
                    Cells(sat, 26).Interior.ColorIndex = 28
                    
                    Cells(sat, 27).Interior.ColorIndex = 6
                    Cells(sat, 29).Interior.ColorIndex = 28
                    
                    Cells(sat, 30).Interior.ColorIndex = 6
                    Cells(sat, 35).Interior.ColorIndex = 28
                    
                    Cells(sat, 36).Interior.ColorIndex = 6
                    Cells(sat, 41).Interior.ColorIndex = 28
                    
                    Range("V" & sat & ":Y" & sat).Interior.ColorIndex = xlNo
                    Range("AB" & sat & ":AC" & sat).Interior.ColorIndex = xlNo
                    Range("AE" & sat & ":AH" & sat).Interior.ColorIndex = xlNo
                    Range("AK" & sat & ":AN" & sat).Interior.ColorIndex = xlNo
                    
            ''''Renlendirmeler sütun bazında tekrar hesaplanıyor
                If Cells(sat, 10) <> Empty Then
                    If Cells(sat, 10) <= Cells(sat, 9) Then
                        Cells(sat, 10).Interior.ColorIndex = 23
                        Else
                        Cells(sat, 10).Interior.ColorIndex = 3
                    End If
                End If
                If Cells(sat, 8) < 0 Then
                    For i = 11 To 17 Step 2
                        If Cells(sat, i) < Cells(sat, i + 1) Then
                            Cells(sat, i).Resize(, 2).Interior.ColorIndex = 24
                            ElseIf Cells(sat, i) > Cells(sat, i + 1) Then
                            Cells(sat, i).Resize(, 2).Interior.ColorIndex = 44
                        End If
                    Next i
                    ElseIf Cells(sat, 8) > 0 Then
                    For i = 11 To 17 Step 2
                        If Cells(sat, i) < Cells(sat, i + 1) Then
                            Cells(sat, i).Resize(, 2).Interior.ColorIndex = 44
                            ElseIf Cells(sat, i) > Cells(sat, i + 1) Then
                            Cells(sat, i).Resize(, 2).Interior.ColorIndex = 24
                        End If
                    Next i
                End If
                If Cells(sat, 19) > 0 Then
                    If Cells(sat, 19) <= Cells(sat, 20) Then
                        Cells(sat, 19).Interior.ColorIndex = 23
                        Else
                        Cells(sat, 19).Interior.ColorIndex = 3
                    End If
                End If
                
                If Cells(sat, 20) > 0 Then
                    If Cells(sat, 20) <= Cells(sat, 19) Then
                        Cells(sat, 20).Interior.ColorIndex = 23
                        Else
                        Cells(sat, 20).Interior.ColorIndex = 3
                    End If
                End If
                
                If Cells(sat, 28) > 0 Then
                    If Cells(sat, 28) <= Cells(sat, 27) Then
                        Cells(sat, 28).Interior.ColorIndex = 23
                        Else
                        Cells(sat, 28).Interior.ColorIndex = 3
                    End If
                End If
                If Cells(sat, 29) > 0 Then
                    If Cells(sat, 29) > Cells(sat, 27) Then
                        Cells(sat, 29).Interior.ColorIndex = 3
                        Else
                        Cells(sat, 29).Interior.ColorIndex = 23
                    End If
                End If
                
                For n = 22 To 25
                    If Cells(sat, n) > 0 Then
                        If Cells(sat, n) < Cells(sat, 21) Then
                            Cells(sat, n).Interior.ColorIndex = 23
                            Else
                            Cells(sat, n).Interior.ColorIndex = 3
                        End If
                    End If
                Next n
                For n = 31 To 34
                    If Cells(sat, n) > 0 Then
                        If Cells(sat, n) < Cells(sat, 30) Then
                            Cells(sat, n).Interior.ColorIndex = 23
                            Else
                            Cells(sat, n).Interior.ColorIndex = 3
                        End If
                    End If
                Next n
                For n = 37 To 40
                    If Cells(sat, n) > 0 Then
                        If Cells(sat, n) < Cells(sat, 36) Then
                            Cells(sat, n).Interior.ColorIndex = 23
                            Else
                            Cells(sat, n).Interior.ColorIndex = 3
                        End If
                    End If
                Next n
 

Ekli dosyalar

muhasebeciyiz' Alıntı:
her iki dosyayıda deneyip geri dönüş yapınız, eline sağlık
Genişletmek için tıkla ...

Üstat öncelikle elinize sağlık, teşekkür ederim.

İkinci dosyada kodlar değişmiş, daha mı iyi olmuş tam emin olamadım fakat size güvenerek bu dosya ile devam etmek istiyorum.

Birinci olarak, Ana Sayfada V24-Y39 hücreleri üstteki (V6-Y21) hücrelerle aynı renk olması lazım

basket-1.jpg

İkinci olarak da yine Ana Sayfada satırlardaki veriyi silince bazı bölümlerde biçimlendirme gitmiyor, diğer satırlarda olduğu gibi buralarda da veri silinince biçimlendirmenin de silinmesi gerekiyor.

basket-2.jpg

Bu iki sorunu da hallederseniz çok memnun olurum. Dosyayı ekledim.
 

Ekli dosyalar

Eyvallah üstat, elinize sağlık, çok teşekkür ederim.
 
muhasebeciyiz' Alıntı:
deneyin bakalım
Genişletmek için tıkla ...

Üstat, tuhaf bir durum var, epey zamandır uğraşıyorum ama bir türlü sebebini bulamadım.

Ana Sayfada maçları getir dediğimde ev sahibinin maçları hemen geliyor fakat deplasman takımının maçları tek tek geliyor, bu da baya zaman alıyor. Acaba bunun sebebi ne olabilir?
 

Ekli dosyalar

Bence doğru çözüm AnaSayfaMaclariniRenklendir prosedüründeki ekran açma-kapama satırlarını kaldırmak ve ekran yönetimini yalnızca ana makroda yapmaktır. Otomatik hesaplamayı da işlem sırasında kapatırsak makro ayrıca belirgin şekilde hızlanır.

Yani sorun deplasman takımının AW sütununda aranması değil; ev sahibi işlemi bittikten sonra ekran güncellemenin erkenden açılmasıdır.
 
Üstat, mesai bitiyor bu nedenle çok bakamadım ama sanki sorun çözülmüş, akşama evde detaylı bakıp sonucu söylerim.

Teşekkür ederim.
 
Üstat Şöyle bir sorun var, şimdi Basketbol sayfasında bir maç seçtiğimde Ana Sayfada ilk maç o seçtiğim tarihteki maç olmalı, fakat şimdi bir takıma tıkladığımda Ana Sayfada o takımın en son oynadığı maç ilk maç oluyor.

Örneğin; 17. satırdaki 6.07.2026 tarihinde oynanmış Slovenya-İsveç maçına tıkladığımda Ana Sayfada ilk maç 19.08.2026 tarihindeki (yani en son oynanan) Slovenya-Letonya maçı geliyor.
 
Yeni çalışma düzeni şöyle olacak:

Basketbol sayfasında 17. satırdaki Slovenya–İsveç maçını seçersiniz.
Seçim kodu Ana Sayfa!A1 hücresine 17 yazar.
Yeni makro taramaya 17. satırdan başlar.
Ana Sayfa’daki ilk ev sahibi maçı Slovenya–İsveç olur.
satırın üzerindeki, yani daha sonraki tarihli Slovenya–Letonya maçı listeye alınmaz.
Seçilen maçtan önce oynanmış eski maçlar sırasıyla altına gelir.
 

Ekli dosyalar

Eyvallah üstat, sorun çözüldü. Çok teşekkür ederim.

NOT: Başka bir sorun görürsem hoşgörünüze sığınarak başlığa tekrar yazarım. Sağlıcakla kalın.
 
muhasebeciyiz' Alıntı:
Yeni çalışma düzeni şöyle olacak:

Basketbol sayfasında 17. satırdaki Slovenya–İsveç maçını seçersiniz.
Seçim kodu Ana Sayfa!A1 hücresine 17 yazar.
Yeni makro taramaya 17. satırdan başlar.
Ana Sayfa’daki ilk ev sahibi maçı Slovenya–İsveç olur.
satırın üzerindeki, yani daha sonraki tarihli Slovenya–Letonya maçı listeye alınmaz.
Seçilen maçtan önce oynanmış eski maçlar sırasıyla altına gelir.
Genişletmek için tıkla ...

Üstat bir soru daha soracağım, umarım hoş karşılarsın.

Ana Sayfada maçları getirdikten sonra 15 - 10 - 6 butonlarına tıklayarak aşağıdaki kodlarla maçların sayısını azaltıyorum. Önceden butonlara tıklayınca hemen maçlar azalıyordu, şimdi ise sanki tarama yaparak azalıyor. Çok rahatsız edici değil ama eskisi gibi taramadan yaparsa daha iyi olur. İlk maç olan Slovenya-Letonya maçında daha bariz belli oluyor.

Kod: 
Sub temizle_onbes_mac()
Set S2 = ThisWorkbook.Worksheets("Ana Sayfa")
S2.Range("B22:AO26").ClearContents
S2.Range("B45:AO49").ClearContents

End Sub

Sub temizle_on_mac()
Set S2 = ThisWorkbook.Worksheets("Ana Sayfa")
S2.Range("B17:AO26").ClearContents
S2.Range("B40:AO49").ClearContents

End Sub

Sub temizle_alti_mac()
Set S2 = ThisWorkbook.Worksheets("Ana Sayfa")
S2.Range("B13:AO26").ClearContents
S2.Range("B36:AO49").ClearContents

End Sub
 

Ekli dosyalar

Kod: 
Option Explicit

Sub temizle_onbes_mac()
    MaclariTemizle "B22:AO26", "B45:AO49"
End Sub

Sub temizle_on_mac()
    MaclariTemizle "B17:AO26", "B40:AO49"
End Sub

Sub temizle_alti_mac()
    MaclariTemizle "B13:AO26", "B36:AO49"
End Sub

Private Sub MaclariTemizle(ByVal Alan1 As String, _
                           ByVal Alan2 As String)

    Dim S2 As Worksheet
    Dim EskiHesaplama As XlCalculation
    Dim EskiEkran As Boolean
    Dim EskiOlaylar As Boolean

    On Error GoTo GuvenliCikis

    Set S2 = ThisWorkbook.Worksheets("Ana Sayfa")
    
    EskiEkran = Application.ScreenUpdating
    EskiOlaylar = Application.EnableEvents
    EskiHesaplama = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Union(S2.Range(Alan1), S2.Range(Alan2)).ClearContents

GuvenliCikis:
    Application.Calculation = EskiHesaplama
    Application.EnableEvents = EskiOlaylar
    Application.ScreenUpdating = EskiEkran

    If Err.Number <> 0 Then
        MsgBox "Maçlar temizlenirken hata oluştu:" & vbCrLf & _
               Err.Description, vbExclamation
    End If

End Sub

Dosyada Worksheet_Change ve Worksheet_Calculate olayları bulunuyor. ClearContents iki ayrı işlem halinde çalışınca bu olaylar ve formül hesaplamaları tekrar tekrar tetikleniyor; gördüğünüz “tarama” etkisinin muhtemel nedeni bu.Bu kdları kullanın
 
Üstat, teşekkür ederim, tarama sorunu bitti, şimdi ise temizlenen hücrelerin biçimleri temizlenmiyor.

Birinci resim eski kodlarla temizleme yaptıktan sonraki hal, ikinci resim ise bu son kodlardan sonra temizleme yaptıktan sonraki hal. Bunu nasıl çözebiliriz?

biçim-1.png

biçim-2.png
 
Üstat sizi çok meşgul ettim farkındayım, hakkınızı helal edin. Dosyada sorun kalmadı, çok teşekkür ederim, elinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst