hakedis icin makro lütfen

[erdalo]

Arkadaşlar Merhaba

Ekte bulunan dosyadaki açıklamaya göre makrolu yardım rica ediyorum yardımcı olursanız sevinirim. Şimdiden teşekkürler

 

[Orion1]

Dosyanız ekte.

Sub hakedis()
Dim i As Long, sat As Long, aralik1 As String, aralik2 As String, kriter1 As String, kriter2 As String
Dim k As Byte, adr As String
Sheets("YOZGAT TELEKURYE").Select
sat = 2
Application.ScreenUpdating = False
Range("K2:Q65536").Clear
For i = 2 To Cells(65536, "C").End(xlUp).Row
    If WorksheetFunction.CountIf(Range("C2:C" & i), Range("C" & i).Value) = 1 Then
        Cells(sat, "K").Value = Cells(i, "C").Value
        sat = sat + 1
    End If
Next i
aralık1 = "C2:C" & i - 1
aralık2 = "E2:E" & i - 1
aralık3 = "F2:F" & i - 1
For i = 2 To Cells(65536, "K").End(xlUp).Row
    kriter1 = Cells(i, "K").Value
    kriter2 = "İMZALI"
    Cells(i, "L").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
    kriter2 = "İMZASIZ"
    Cells(i, "M").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
    kriter2 = "FÖY"
    Cells(i, "N").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
    kriter2 = "KISIYE OZEL"
    Cells(i, "O").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
    kriter2 = "DEDİKE"
    Cells(i, "P").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
    kriter2 = "Y.K.B"
    Cells(i, "Q").Value = Evaluate("=SumProduct((" & aralık1 & "=""" & kriter1 & """)*(" & aralık2 & "=""" & kriter2 & """)*(" & aralık3 & "))")
Next i
Cells(i, "K").Value = "TOPLAM............................:"
For k = 12 To 17
    adr = Range(Cells(2, k), Cells(i - 1, k)).Address
Cells(i, k).Formula = "=sum(" & adr & ")"
Next k
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

 

[erdalo]

Sayın evren yardımlarınız için çok teşekkür ederim.
emek harcadığınız için teşekkür ederim.

 

[Orion1]

Sayın evren yardımlarınız için çok teşekkür ederim.
emek harcadığınız için teşekkür ederim.

Rica ederim.
İyi çalışmalar.

 

[erdalo]

Sayın evren
Yine ben

kriter2 herzaman tanımladığınız sütunda olmayabiliyor. k sütunundan sonraki herhangibir sütunda olabiliyor.
Ayrıca sayfa adı herzaman aynı olmayabiliyor. Sayfa adı değişebiliyor.
makroyu yeniden düzenleyebilirmisiniz.
Teşekkürler