• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan aylax
  • Başlangıç tarihi Başlangıç tarihi
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:olabileceksede;
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.
 
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
 
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:
&#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.
 
Geri
Üst