• DİKKAT

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

Hücreler boyandıkça yüzde gösterme

Katılım
11 Ağustos 2005
Mesajlar
98
Merhaba,

örneğin B1 hücresinden K1 hücresine kadar verilerim var. B1 hücresini sarıya boyadığımda yüzde 10 bitmiş yazacak bunu A1 hücresinde gösterecek.. C1 hücresini boyadığımda yüzde 20 bitmiş olacak tamamını boyadığımda A1 hücresi yüzde yüz olacak.

umarım anlata bildim. teşekkür ederim.
 
Merhaba,

örneğin B1 hücresinden K1 hücresine kadar verilerim var. B1 hücresini sarıya boyadığımda yüzde 10 bitmiş yazacak bunu A1 hücresinde gösterecek.. C1 hücresini boyadığımda yüzde 20 bitmiş olacak tamamını boyadığımda A1 hücresi yüzde yüz olacak.

umarım anlata bildim. teşekkür ederim.
bunu sadece A1 hücresinde tek mi yazılsın yoksa altındakileredemi yazsın
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call UpdateCompletionPercentage
End Sub


Sub UpdateCompletionPercentage()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim filledCount As Integer
Dim totalCount As Integer
Dim completionPercentage As Double

' Aktif sayfayı tanımlayın
Set ws = ActiveSheet

' B1 ile K1 aralığını tanımlayın
Set rng = ws.Range("B1:K1")
totalCount = rng.Count

' Sarıya boyanmış hücreleri sayın
filledCount = 0
For Each cell In rng
If cell.Interior.Color = RGB(255, 255, 0) Then
filledCount = filledCount + 1
End If
Next cell

' Tamamlanma yüzdesini hesaplayın
completionPercentage = (filledCount / totalCount) * 100

' A1 hücresine tamamlanma yüzdesini yazın
ws.Range("A1").Value = "Yüzde " & completionPercentage & " bitmiş"
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call UpdateCompletionPercentage
End Sub


Sub UpdateCompletionPercentage()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim filledCount As Integer
Dim totalCount As Integer
Dim completionPercentage As Double

' Aktif sayfayı tanımlayın
Set ws = ActiveSheet

' B1 ile K1 aralığını tanımlayın
Set rng = ws.Range("B1:K1")
totalCount = rng.Count

' Sarıya boyanmış hücreleri sayın
filledCount = 0
For Each cell In rng
If cell.Interior.Color = RGB(255, 255, 0) Then
filledCount = filledCount + 1
End If
Next cell

' Tamamlanma yüzdesini hesaplayın
completionPercentage = (filledCount / totalCount) * 100

' A1 hücresine tamamlanma yüzdesini yazın
ws.Range("A1").Value = "Yüzde " & completionPercentage & " bitmiş"
End Sub
merhaba,

hocam çok güzel anlatmışsın eline sağlık, ben bunu hücreye mi yazacağım, yoksa makroya mı bilemedim.
 
hayır..

Aşağıda sayfalara sağ tuşlayın kodu göster diyin .

ve kodları yapıştırıp deneyin
 
Geri
Üst