dolu hücreleri nasıl biçimlendiririm,renklendiririm?

Katılım
15 Ocak 2007
Mesajlar
86
Excel Vers. ve Dili
excel 2003 türkçe
Arkadaşlar herkese merhaba,kolay gelsin
O kadar çok çalışma varki renklendirme ile ilgili olarak forumda,hangisinde bu konuyu çözerim diye çok uğraştım.
1-Basitçe ,sadece dolu olan a1:z8000 aralığındaki hücrelerimi tümünü makro ile nasıl renklendiririm.Dikkat !boş olan hücrelerde renklendirme olmamalı,olduğu gibi blank kalacak.Tabloyu buşekilde yaparsanızda olur
Fakat:eek:labileceksede;
2-olabilirse bu tabloda "eğer hücre içinde (1a,8b,3e6 .....gibi,sadece üç harf var.a,b,e.) a" varsa o hücre kırmızı[/COLOR],"b" varsa yeşil,"e" varsa mavi yapılabilirmi?
Esen kalın.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ekli dosyayı inceleyiniz.Butona basınız.:cool:
Kod:
Sub renklendir()
Dim hucre As Range
Dim i As Byte, deg As Long, sonuc As Long
For i = 1 To 26
deg = Cells(65536, i).End(xlUp).Row
If deg > sonuc Then sonuc = deg
Next i
For Each hucre In Range("A1:Z" & sonuc)
    If hucre.Value <> "" Then
        For i = 1 To Len(hucre.Value)
            If Mid(hucre.Value, i, 1) = "a" Then hucre.Interior.ColorIndex = 3
            If Mid(hucre.Value, i, 1) = "b" Then hucre.Interior.ColorIndex = 4
            If Mid(hucre.Value, i, 1) = "e" Then hucre.Interior.ColorIndex = 41
        Next
        Else
        hucre.Interior.ColorIndex = xlNone
    End If
Next
MsgBox "İşlem Tamam", vbOKOnly + vbInformation
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Doğru mu anladım bilmiyorum, dosyayı inceler misiniz?


Kod:
Public Sub Renklendir()
Application.ScreenUpdating = False
On Error Resume Next
For Each hücre In Range("A1:Z8000")
    i = 0
    j = 0
    k = 0
    If hücre = "" Then GoTo Devam
    i = Application.WorksheetFunction.Find("a", hücre)
    If i > 0 Then hücre.Interior.ColorIndex = 3
    j = Application.WorksheetFunction.Find("b", hücre)
    If j > 0 Then hücre.Interior.ColorIndex = 4
    k = Application.WorksheetFunction.Find("e", hücre)
    If k > 0 Then hücre.Interior.ColorIndex = 5
Devam:
Next hücre
MsgBox "İşlem Bitmiştir ...."
End Sub
 
Son düzenleme:
Katılım
15 Ocak 2007
Mesajlar
86
Excel Vers. ve Dili
excel 2003 türkçe
&#199;ok ama &#231;ok te&#351;ekk&#252;r ederim,her iki uygulamada ok.
Esen kal&#305;n,&#231;ok te&#351;ekk&#252;rler.
 
Üst