Başarı Oranı Tablosu

[skoca]

Öncelikle herkese iyi günler,

Elimde şirketimiz çalışanlarının başarı oranları var ve ekte gönderdiğim şekilde bir düzenleme yapmam gerekiyor. Yardım edebilirseniz sevinirim.

Emeği geçecek herkese şimdiden teşekkür ederim.
Saygılarımla,

 

[uzmanamele]

merhaba

bu işinizi görür mü?

=TOPLA.ÇARPIM((B2='Personel Performans'!$B$2:$B$13)*('Personel Performans'!$P$2:$P$13>0))

=TOPLA.ÇARPIM((B2='Personel Performans'!$B$2:$B$13)*('Personel Performans'!$P$2:$P$13<=0))

 

[Orion1]

Dosyanız ekte.

Sub basari()
Dim i As Long, sat As Long
Dim z1 As Object, z2 As Object, k As Range
Sheets("Sayfa2").Select
Application.ScreenUpdating = False
Range("A2:E65536").Clear
sat = 2
Set z1 = CreateObject("Scripting.Dictionary")
Set z2 = CreateObject("Scripting.Dictionary")
With Sheets("Personel Performans")
    For i = 2 To .Cells(65536, "A").End(xlUp).Row
        If WorksheetFunction.CountIf(.Range("A2:A" & i), .Cells(i, "A").Value) = 1 Then
            Cells(sat, "A").Value = .Cells(i, "A").Value
            Cells(sat, "B").Value = .Cells(i, "B").Value
            Cells(sat, "C").Value = .Cells(i, "C").Value
            sat = sat + 1
        End If
        If .Cells(i, "P").Value > 0 Then
            If Not z1.exists(.Cells(i, "A").Value) Then
                z1.Add (.Cells(i, "A").Value), 1
                Else
                z1.Item(.Cells(i, "A").Value) = z1.Item(.Cells(i, "A").Value) + 1
            End If
        Else
            If Not z2.exists(.Cells(i, "A").Value) Then
                z2.Add (.Cells(i, "A").Value), 1
                Else
                z2.Item(.Cells(i, "A").Value) = z2.Item(.Cells(i, "A").Value) + 1
            End If
        End If
    Next
End With
For Each vkey In z1.keys
    Set k = Range("A2:A65536").Find(vkey, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(k.Row, "D").Value = z1.Item(vkey)
    End If
Next
Set k = Nothing
vkey = 0
For Each vkey In z2.keys
    Set k = Range("A2:A65536").Find(vkey, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(k.Row, "E").Value = z2.Item(vkey)
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, "İŞLEM TAMAM"
End Sub

 

[sonsuzkalp]

Evren hocam sizden yardım isteyebilir miyim

 

[Orion1]

Evren hocam sizden yardım isteyebilir miyim

İsteyemezsin.!!
şaka ,şaka.!!
Elimizden geldiğince bilgimiz dahilinde ise yaparız.

 

[sonsuzkalp]

evren hocam teşekkürler sizin için basit bir şeydir ben web tasarımla ilgileniyorum exceli veritabanı olarak kullanabilir miyim yani asp den excele veri kayıtı veya silme işlemini yapabilir miyim hocam

 

[Orion1]

evren hocam teşekkürler sizin için basit bir şeydir ben web tasarımla ilgileniyorum exceli veritabanı olarak kullanabilir miyim yani asp den excele veri kayıtı veya silme işlemini yapabilir miyim hocam

Bu web konusunu sitede daha iyi bilen arkadaşlar,var.Sorunuzu yeni bir başlık açarak sorarsanız sanırım yardım alacaksınızdır.

 

[sonsuzkalp]

teşekürler evren hocam bilgilerinizi takip ediyorum sayesinde baya bir şey öğrendim excel hakkında iyi çalışmalar

 

[skoca]

Sn. Uzmanamele ve Sn. Evren Gizlen,

Öncellikle ilgi ve alakanız için çok teşekkür ederim. ikinizin vermiş olduğu cevap da doğru şekilde çalışıyor. Listem çok uzun ve isimleri manuel girmemek için Sn. Gizlen'in vermiş olduğu cevabı kullanacağım.
Herşey için tekrar teşekkürler...