Sizin işinizi kolaylaştırması için sistematik bir yapı oluşturdum. A sutuna bölge isimlerini istedeğiniz kadar yazabilirsiniz.
C sutunda değerler yer almalı aynen devam ediyor.
D Sutununda ise bölgenin çizimi var ise aktif etmelisiniz yok ise pasif kalmalıdır.
Tek fark güncelle butonuna basmalısınız.
Kolay gelsin.
Kod:
Private Sub CommandButton1_Click()
Call Guncelle
End Sub
Sub Guncelle()
satirsayisi = WorksheetFunction.CountA(Sheets("Sayfa1").Columns("A"))
satirsayisi = satirsayisi - 1
For i = 2 To satirsayisi
Adi = Sheets("Sayfa1").Range("A" & i)
Renk = Sheets("Sayfa1").Range("B" & i)
Durum = Sheets("Sayfa1").Range("D" & i)
Sayi = Renk
If (Durum = "Aktif") Then
If (Sayi >= 1 And Sayi <= 5) Then
ActiveSheet.Shapes(Adi).Fill.ForeColor.SchemeColor = 5
ElseIf (Sayi >= 11 And Sayi <= 15) Then
ActiveSheet.Shapes(Adi).Fill.ForeColor.SchemeColor = 51
ElseIf (Sayi >= 16 And Sayi <= 20) Then
ActiveSheet.Shapes(Adi).Fill.ForeColor.SchemeColor = 4
Else
ActiveSheet.Shapes(Adi).Fill.ForeColor.SchemeColor = 17
End If
Else
If (CheckBox1.Value = True) Then
MsgBox (Adi & " Pasif Durumdadır.")
Else
End If
End If
Next
End Sub