bir başka sayfadaki koşulu sağlayan hücreyi biçimleme

[peleryn]

bul-biçimlendir

Herkese merhabalar;

Ekli dosyamda "AYLIK RESMİ" adlı listede dağıtılan seanslar bir diğer sayfaya listelenmiş vaziyette.

"LİSTE" adlı sayfadaki seanslardan birisini dosyada belirttiğim şekilde işaretlediğimde "AYLIK RESMİ" adlı sayfada işaretlenmiş seanslara karşılık olan seansların biçimlenmesi gerekiyor.

İlgilenecek olan herkese şimdiden teşekkür ederim.

 

[halit3]

Herkese merhabalar;

Ekli dosyamda "AYLIK RESMİ" adlı listede dağıtılan seanslar bir diğer sayfaya listelenmiş vaziyette.

"LİSTE" adlı sayfadaki seanslardan birisini dosyada belirttiğim şekilde işaretlediğimde "AYLIK RESMİ" adlı sayfada işaretlenmiş seansa karşılık olan seansın biçimlenmesi gerekiyor.

İlgilenecek olan herkese şimdiden teşekkür ederim.

ekli dosyaya bir bakarmısınız.

 

[peleryn]

Halit hocam iki nokta var :birincisi "x" ile işaretli olan ilgili tüm hücreler biçimlenmiş olmalı ama malesef ben sadece seans olarak belirttiğim için siz de ona göre yapmışsınız bu hata için özür dilerim.(İlk mesajımda bu hususu düzelttim) ikincisi de sanırım kodlar yukarıdan aşağıya tarıyor ve ilerdeki tarihleri seçersem çok uzun sürüyor işlemi sonlandırması.(Sondan ikinci seansı seçtim..(G680="x" ) yaklaşık 7 dk oldu ve hala kod çalışıyor.

NOT :Eğer denemeler yaparsanız LİSTE sayfasında GRUP olarak belirtilmiş satırları işaretlemeyin.Onlar ana dosyada AYLIK RESMİ sayfasındaki başka satırlardan alınan veriler.

 

[peleryn]

ESC ile makroyu durdurduğumda "Range sınıfının findnext özelliği alınamıyor" diyor.

 

[halit3]

ESC ile makroyu durdurduğumda "Range sınıfının findnext özelliği alınamıyor" diyor.

nu kodu denermisin yanlızca G sutununda "x" işareti ile makro çalışıyor

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:G5000")) Is Nothing Then Exit Sub
a = Target.Row
b = Target.Column
yer1 = Worksheets("LİSTE").Cells(a, 1).Value
yer2 = Worksheets("LİSTE").Cells(a, 2).Value
yer3 = Worksheets("LİSTE").Cells(a, 3).Value
yer4 = Worksheets("LİSTE").Cells(a, 6).Value
yer5 = yer1 & yer2 & yer3 & yer4
If yer1 = "" Then
Exit Sub
ElseIf yer2 = "" Then
Exit Sub
ElseIf yer3 = "" Then
Exit Sub
ElseIf yer4 = "" Then
Exit Sub
ElseIf Worksheets("LİSTE").Cells(a, 5).Value = "" Then
Exit Sub
End If

If LCase(Worksheets("LİSTE").Cells(a, b).Value) <> LCase("x") Then
Exit Sub
End If

Worksheets("AYLIK RESMİ").Cells.Interior.ColorIndex = xlNone
ad = Cells(a, 5).Value
For r = 4 To 9
If ad = Worksheets("AYLIK RESMİ").Cells(2, r).Value Then
satır_no = r
End If
Next

bul = Cells(a, 1).Value
Dim SütunAdı As String
SütunAdı = Split(Cells(a, satır_no).Address, "$")(1)
Set d = Worksheets("AYLIK RESMİ").Range(SütunAdı & "8:" & SütunAdı & 5000).Find(bul, LookAt:=xlWhole)
'Set d = Worksheets("AYLIK RESMİ").Range(SütunAdı & "8:" & SütunAdı & 200).Find(bul, LookIn:=xlValues)
If Not d Is Nothing Then
firstAddress = d.Address
Do
ver2 = Worksheets("AYLIK RESMİ").Cells(d.Row, 10).Value
ver3 = Worksheets("AYLIK RESMİ").Cells(d.Row, 12).Value
ver4 = Worksheets("AYLIK RESMİ").Cells(d.Row, 11).Value
ver5 = bul & ver2 & ver3 & ver4
If yer5 = ver5 Then
Worksheets("AYLIK RESMİ").Cells(d.Row, satır_no).Interior.ColorIndex = 8
Worksheets("AYLIK RESMİ").Cells(d.Row, "J").Interior.ColorIndex = 8
Worksheets("AYLIK RESMİ").Cells(d.Row, "K").Interior.ColorIndex = 8
Worksheets("AYLIK RESMİ").Cells(d.Row, "L").Interior.ColorIndex = 8
Exit Sub
End If
Set d = Worksheets("AYLIK RESMİ").Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End Sub

 

[peleryn]

Halit hocam elinize emeğinize sağlık güzel kodlar olmuş gayet hızlı da çalışıyor.fakat istediğim tam olarak bu da değildi.

şöyle bir örnek vereyim selection change değilde sanırım bir buton daha iyi çalışacak.

Diyelim ki LİSTE sayfasında G8,G18,G54,G100 hücrelerinde X işareti var bu durumda AYLIK RESMİ sayfasında E10,D13,G23 VE D37 hücrelerinin tümü aynı anda biçimlenmiş olacak.hepsini mavi olarak göreceğim ki diğer sayfada X ile işaretlendiklerini anlayayım.

Ve diyelim ki X ların hepsini sildim o zaman AYLIK RESMİ sayfasında hiç mavi hücre olmayacak..
Bir başka seferde de diyelim ki bazı X ları kaldırdım ve yeni X lar ekledim butona bastığımda yeni duruma uygun hücrelerin hepsi diğer sayfada mavi ile işaretlenmiş olacak.

İlgi ve emeğiniz için tekrar teşekkür ediyorum.

 

[halit3]

ekli dosyayı kontrol edermisiniz.?

 

[peleryn]

Halit hocam ellerinize sağlık hızlı yardımınız sayesinde bugün işlerimizi çok hafifletecek.Yardımınız için teşekkür ederim bu haliyle gayet güzel oldu ellerinize sağlık.

 

[halit3]

iyi çalışmalar diliyorum

 

[peleryn]

Halit hocam hazırladığınız kodlarla sayenizde dosyam çok daha rahat çalışıyor ve hayli zamandan kazanmamı sağladı.Yalnız aksaklık yaratan bir durum var sizi yormadan kodlar üzerinde kendim halletmeyi denedim bir iki gündür ama beceremedim.

Biliyorsunuz "x" ile işaretlediğim bir seans diğer sayfada istenen şekilde biçimleniyor.Ama herhangi bir sebepten (yanlış yapmış olma ya da gereken bir değişiklik için) bir "x" işaretini sildiğimde haliyle diğer sayfadaki ilgili hücre biçimini koruyor.Kodları bu değişikliklere duyarlı hale nasıl getirebiliriz.Herhangi bir "x" işareti kalktığında buna bağlı hücredeki biçimlemenin de kalkmasını nasıl sağlayabiliriz..?Yardımcı olursanız sevinirim..

 

[halit3]

7 nolu mesajdaki dosyayı güncelledim kontrol ediniz.

 

[peleryn]

Halit hocam dosyayla tekrar ilgilendiğiniz için teşekkür ederim.Gayet güzel çalışıyor sağolun ellerinize sağlık..