Data Bar biçimlendirme

[muhammed yıldız]

Merhaba,

Ekteki dosyamda görüldüğü üzere çok fazla satır var. Data Bar ile biçmlendirme yapmak istediğimde renkler görünmeyecek kadar azalıyor. üstte ayrı yaptığım gibi görünmüyor. Her satırı tek tek nasıl yapabilirim ?

Yardımlarınız için teşekkür ederim.

 

[muhammed yıldız]

yardımınız lütfen

 

[Korhan Ayhan]

Deneyiniz.

Bende ~190 saniyede işlemi tamamladı.

Option Explicit

Sub Satirlari_Ayri_Ayri_Bicimlendir()
    Dim X As Long, Zaman As Double
   
    Application.ScreenUpdating = False
   
    Zaman = Timer
   
    Range("B:G").FormatConditions.Delete
   
    For X = 4 To Cells(Rows.Count, 2).End(3).Row
        If Cells(X, 2) <> "" Then
            With Range("B" & X & ":G" & X)
                .FormatConditions.AddDatabar
                .FormatConditions(.FormatConditions.Count).ShowValue = True
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                .FormatConditions(1).MinPoint.Modify newtype:=xlConditionValueAutomaticMin
                .FormatConditions(1).MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
                .FormatConditions(1).BarColor.Color = 2668287
                .FormatConditions(1).BarColor.TintAndShade = 0
                .FormatConditions(1).BarFillType = xlDataBarFillGradient
                .FormatConditions(1).Direction = xlContext
                .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
                .FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
                .FormatConditions(1).NegativeBarFormat.BorderColorType = xlDataBarColor
                .FormatConditions(1).BarBorder.Color.Color = 2668287
                .FormatConditions(1).BarBorder.Color.TintAndShade = 0
                .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
                .FormatConditions(1).AxisColor.Color = 0
                .FormatConditions(1).AxisColor.TintAndShade = 0
                .FormatConditions(1).NegativeBarFormat.Color.Color = 255
                .FormatConditions(1).NegativeBarFormat.Color.TintAndShade = 0
                .FormatConditions(1).NegativeBarFormat.BorderColor.Color = 255
                .FormatConditions(1).NegativeBarFormat.BorderColor.TintAndShade = 0
                .FormatConditions.AddIconSetCondition
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                .FormatConditions(1).ReverseOrder = False
                .FormatConditions(1).ShowIconOnly = False
                .FormatConditions(1).IconSet = ActiveWorkbook.IconSets(xl3Arrows)
                .FormatConditions(1).IconCriteria(2).Type = xlConditionValuePercent
                .FormatConditions(1).IconCriteria(2).Value = 33
                .FormatConditions(1).IconCriteria(2).Operator = 7
                .FormatConditions(1).IconCriteria(3).Type = xlConditionValuePercent
                .FormatConditions(1).IconCriteria(3).Value = 67
                .FormatConditions(1).IconCriteria(3).Operator = 7
            End With
        End If
    Next

    Application.ScreenUpdating = True

    MsgBox "İşlemini tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[muhammed yıldız]

merhaba,

geri dönüş için teşekkür ediyorum.
hiç anlamadığım ve Sanırım fazlasıyla uğraşmam gereken bir şekilde çözülüyor.

Yine de tekrar çok teşekkür ediyorum.

 

[Korhan Ayhan]

Aşağıdaki şekilde uygulayabilirsiniz.

Dosyanızı açın.
ALT+F11 tuşlarına basarak kod editörün açın.
INSERT menüsünden MODULE seçeneğine tıklayın.
Açılan beyaz pencereye verdiğim kodu uygulayın. (Kopyala-yapıştır)
Dosyanızı farklı kaydedin. Kaydederken dosya türünü Makro İçeren Excel Dosyası biçiminde kaydedin.
Excel sayfanıza geri dönün.
EKLE menüsünden sayfanıza bir şekil (dikdörtgen) ekleyin. (Buton görevi görecek)
Eklediğiniz şekil üzerinde sağ tıklayın ve MAKRO ATA seçeneğine tıklayın.
Karşınıza gelen menüde verdiğim makro adını göreceksiniz. Onu seçip tamam deyin.

Artık butona tıklayıp işlemin bitmesini bekleyebilirsiniz.

 

[muhammed yıldız]

Harika !

Emeğinize elinize sağlık .
Çok teşekkürler.

Saygılar.