Kodlarla koşullu biçimlendirme

[Sa.NaL]

şimdiki haliyle s2:s65 arası minimumu arıyor sayıya göre minimumu söylüyor ben sayının yanında artık hücre rengininde söz konusu olmasını istiyorum en küçük sayı değil beyaz olupta en küçük sayı hangisi yada hangileri ise o hücre rengi yeşil olsun istiyorum

 

[leumruk]

Bu arada bu siteden dosya indiremiyorum. Sanırım bir arıza var. Bu nedenle dosyanıza bakamadım.

 

[Sa.NaL]

http://www.4shared.com/file/100485483/9783ed8/ek_online.html

 

[leumruk]

şimdiki haliyle s2:s65 arası minimumu arıyor sayıya göre minimumu söylüyor ben sayının yanında artık hücre rengininde söz konusu olmasını istiyorum en küçük sayı değil beyaz olupta en küçük sayı hangisi yada hangileri ise o hücre rengi yeşil olsun istiyorum

Şimdi işler değişti. Kodun temel yapısının değişmesi lazım. Nasıl olacağı hakkında şu an bir fikrim yok.

 

[Sa.NaL]

For i = 1 To [A65536].End(3).Row
If Cells(i, 1).Font.Bold = True Then
Cells(i, 1).Select
Selection.Copy
Cells([B65536].End(3).Row + 1, 2).Select
ActiveSheet.Paste
End If
Next
Application.CutCopyMode = False

böyle bir örnek buldum farklı yere kalınları taşıyor bizde beyazları taşıyıp orada yapamazmıyız ama hücrelerin tam hizasına taşısın bu yukarıdaki örnek yukarıdan aşağıya sıralıyor ayırt ettiklerini benim istediğim beyaz s40 da ise t40 a atsın s35 de ise t35 atsın arası kırmızı ise t36 dan t39 boş kalsın mesela

 

[Sa.NaL]

Çünkü ona görede son döngümü yazacağım eğer örneğin T40 yeşil ise TASARIM SAYFASINDA G17:G20 YEŞİL OLSUN bu son döngülerim olacak o yüzden s'de belirtilen hücre nin tam yanına sayıyı taşıması önemli hocam

 

[Sa.NaL]

yada uzunda olsa bir yol buldum hocam 64 tane hesap varya s2:s65 e kadar 64 tane" hesap" adlı sayfanın kod bölmümüne if döngüsü kurayım hangisi beyaz ise karşısına eşitlesin içindeki sayıyı else boş kalsın bu döngü kurmadan fx ile yapılırmı basit yolu varmı?

 

[leumruk]

Yan hücreye taşıyarak çözebiliriz; fakat konuya yarın bakabilirim. Dosyayı da nedense indiremiyorum. Yarın bir de okulda deneyeyim.

 

[Sa.NaL]

tşkler iyi uykular

 

[Ömer]

Merhaba,

Tam olarak konuyu incelemedim fakat, yarı formül yarı makro ile alternatif olarak bir çözüm sunmak istedim.

Renkli zemin ve Font Özelliklerine Göre Uygulamalar

Linkte Renk adları sayfasında kullanılan KTF ile ( =Hücrerengi(A3;0) )

Örneğin, beyaz hücreler önce U sütununda,

=EĞER(hücrerengi(S2;0)=2;S2;"")

formülü ile bulunur. Daha sonra T sütununa,

=EĞER(MİN($U$2:$U$65)=U2;U2;"")

yazılarak sadece beyaz olan hücre renklerinin min. değeri bulunurak satır karşına yazılır..

Umarım doğru anlamışımdır..

.

 

[Sa.NaL]

evet doğru anladınız ama #AD? die hata veriyor

 

[Ömer]

evet doğru anladınız ama #AD? die hata veriyor

Linkteki dosyada module2 deki KTF yi almadınız sanırım..

.

 

[Sa.NaL]

KTF die birşey benim örneğimde yokki o ne anlamadım

 

[Sa.NaL]

hocam 23 .konuda linkte öneğim var ona dediğinizi doğru anladınız adapte edip bana ekleyebilirmisiniz buraya kafam artık inanın almıyor durdu

 

[Ömer]

30. mesajda verdiğim linkteki dosyada module2 deki kodları kendi dosyanızda boş bir module kopyalayınız.

=Hücrerengi(S2;0) formülünün ( KTF Kullanıcı Tanımlı Fonksiyon ) çalışması için bu kodlar gereklidir..

Aşağıdaki kodları boş bir module kopyalayınız..

Function HücreRengi(Aralık As Range, Optional Renkadi As Boolean)
Dim Renkismi As String, IndeksNo As Integer
Select Case Aralık.Interior.ColorIndex
   Case 1
    Renkismi = "Siyah"
    IndeksNo = 1
   Case 53
    Renkismi = "Kahverengi"
    IndeksNo = 53
   Case 52
    Renkismi = "Zeytin Yeşili"
    IndeksNo = 52
   Case 51
    Renkismi = "Koyu Yeşil"
    IndeksNo = 51
   Case 49
    Renkismi = "Koyu Haki"
    IndeksNo = 49
   Case 11
    Renkismi = "Koyu Mavi"
    IndeksNo = 11
   Case 55
    Renkismi = "Çivit Mavi"
    IndeksNo = 55
   Case 56
    Renkismi = "Gri-80%"
    IndeksNo = 56
   Case 9
    Renkismi = "Koyu Kırmızı"
    IndeksNo = 9
   Case 46
    Renkismi = "Turuncu"
    IndeksNo = 46
   Case 12
    Renkismi = "Koyu Sarı"
    IndeksNo = 12
   Case 10
    Renkismi = "Yeşil"
    IndeksNo = 10
   Case 14
    Renkismi = "Haki"
    IndeksNo = 14
   Case 5
    Renkismi = "Mavi"
    IndeksNo = 5
   Case 47
    Renkismi = "Mavi-Gri"
    IndeksNo = 47
   Case 16
    Renkismi = "Gri-50%"
    IndeksNo = 16
   Case 3
    Renkismi = "Kırmızı"
    IndeksNo = 3
   Case 45
    Renkismi = "Parlak Turuncu"
    IndeksNo = 45
   Case 43
    Renkismi = "Limon Yeşil"
    IndeksNo = 43
   Case 50
    Renkismi = "Deniz Yeşil"
    IndeksNo = 50
   Case 42
    Renkismi = "Su"
    IndeksNo = 42
   Case 41
    Renkismi = "Parlak Mavi"
    IndeksNo = 41
   Case 13
    Renkismi = "Menekşe"
    IndeksNo = 13
   Case 48
    Renkismi = "Gri-40%"
    IndeksNo = 48
   Case 7
    Renkismi = "Pembe"
    IndeksNo = 7
   Case 44
    Renkismi = "Altın"
    IndeksNo = 44
   Case 6
    Renkismi = "Sarı"
    IndeksNo = 6
   Case 4
    Renkismi = "Parlak Yeşil"
    IndeksNo = 4
   Case 8
    Renkismi = "Turkuaz"
    IndeksNo = 8
   Case 33
    Renkismi = "Gök Mavi"
    IndeksNo = 33
   Case 54
    Renkismi = "Erik Rengi"
    IndeksNo = 54
   Case 15
    Renkismi = "Gri-25%"
    IndeksNo = 15
   Case 38
    Renkismi = "Gül"
    IndeksNo = 38
   Case 40
    Renkismi = "Sarımsı-Kahve"
    IndeksNo = 40
   Case 36
    Renkismi = "Parlak Yellow"
    IndeksNo = 36
   Case 35
    Renkismi = "Parlak Yeşil"
    IndeksNo = 35
   Case 34
    Renkismi = "Parlak Turkuaz"
    IndeksNo = 34
   Case 37
    Renkismi = "Soluk Mavi"
    IndeksNo = 37
   Case 39
    Renkismi = "Lavanta"
    IndeksNo = 39
   Case 2
    Renkismi = "Beyaz"
    IndeksNo = 2
  Case Else
    Renkismi = "Tanımlanmış renk yada dolgu yok"
End Select
    If Renkadi = True Or _
        Renkismi = "Tanımlanmış renk yada dolgu yok" Then
        HücreRengi = Renkismi
    Else
        HücreRengi = IndeksNo
    End If
End Function

.

 

[Sa.NaL]

ben dosya göremiyorum 30. konuda sitede sorunmu var

 

[Ömer]

ben dosya göremiyorum 30. konuda sitede sorunmu var

Sayın Sa.NaL,

Dosya değil link eklemiştim. #35 nolu mesaja kodları ekledim, ordan alabilirsiniz..

.

 

[Sa.NaL]

çok sağolunda ben bunları anlayana kadar sabah olur hocam ben okadar profesyonel değilim ki neyse yinede sağolun iyi çalışmalar

 

[Ömer]

Eki inceleyiniz..

.

 

[Sa.NaL]

çok tşk ederim şimdi oldu işde anlamaya çalışayım kodlara bakıp elinize sağlık