Sayilarin Belİrlİ Sutunlarda Toplanmasi

[senerozun]

Sayilarin Belİrlİ Sutunlarda Toplanmasi Konusunda AŞaĞida Ornekte Makro İle Nasil Yapabİlİrİm. Yardimci Olabİlİrsenİz Sevİnİrİm

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kullanılan kod;

Sub AKTAR()
    Application.ScreenUpdating = False
    Set SO = Sheets("ORNEK")
    Set SR = Sheets("RAPOR")
    SR.Cells.Delete
    SR.[IR1] = "KOD1"
    SR.[IS1] = "KOD2"
    SR.[IT1] = "KOD3"
    SR.[IU1] = "ADA"
    SR.[IV1] = "PARSEL"
    SO.Columns("A:A").SpecialCells(xlCellTypeConstants, 1).Copy SR.[IR2]
    SO.Columns("C:D").SpecialCells(xlCellTypeConstants, 1).Copy SR.[IS2]
    SO.Columns("L:M").SpecialCells(xlCellTypeConstants, 1).Copy SR.[IU2]
    SR.Columns("IR:IV").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=SR.Range("IM1"), Unique:=True
    SR.Select
    [A1].Select
    Cells.VerticalAlignment = xlCenter
    [A1] = "KOD"
    [L1] = "ADA"
    [M1] = "PARSEL"
    [N1] = "BLOK1"
    [O1] = "BLOK2"
    [A:A].HorizontalAlignment = xlCenter
    [A1:O1].Font.Bold = True
    [A1:O1].HorizontalAlignment = xlCenter
    Range("A2:A" & [IM65536].End(3).Row).Value = Range("IM2:IM" & [IM65536].End(3).Row).Value
    Range("C2:D" & [IM65536].End(3).Row).Value = Range("IN2:IO" & [IM65536].End(3).Row).Value
    Range("L2:M" & [IM65536].End(3).Row).Value = Range("IP2:IQ" & [IM65536].End(3).Row).Value
    For X = [A65536].End(3).Row To 3 Step -1
    If Cells(X, 1) <> Cells(X - 1, 1) Then
    Rows(X & ":" & X + 1).Insert
    End If
    Next
    
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) <> "" Then
    İLK_SATIR = Evaluate("=MIN(IF(ORNEK!A:A=" & "A" & X & ",ROW(1:65536)))")
    TOPLAM = Evaluate("=MAX(IF(ORNEK!A:A=" & "A" & X & ",ROW(1:65536)))") + 1
    Range("F" & X & ":K" & X).Value = SO.Range("F" & İLK_SATIR & ":K" & İLK_SATIR).Value
    Cells(X, "N") = Evaluate("=SUMPRODUCT((ORNEK!A2:A65536=" & "A" & X & ")*(ORNEK!L2:L65536=" & "L" & X & ")*(ORNEK!M2:M65536=" & "M" & X & ")*(ORNEK!N2:N65536))")
    Cells(X, "O") = Evaluate("=SUMPRODUCT((ORNEK!A2:A65536=" & "A" & X & ")*(ORNEK!L2:L65536=" & "L" & X & ")*(ORNEK!M2:M65536=" & "M" & X & ")*(ORNEK!O2:O65536))")
    SAY = WorksheetFunction.CountIf([A:A], Cells(X, 1))
    For Y = X To X + SAY
    If Cells(Y, 1) = Cells(X, 1) And Cells(Y + 1, 1) = "" Then
    SATIR = Y + 1
    Exit For
    End If
    Next
    Cells(SATIR, "L") = "Toplam"
    Cells(SATIR, "L").Font.Bold = True
    Cells(SATIR, "L").HorizontalAlignment = xlCenter
    Cells(SATIR, "N") = SO.Cells(TOPLAM, "N")
    Cells(SATIR, "N").Font.Bold = True
    Cells(SATIR, "O") = SO.Cells(TOPLAM, "O")
    Cells(SATIR, "O").Font.Bold = True
    End If
    Next
    [IM:IV].Delete
    Application.ScreenUpdating = True
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[senerozun]

Korhan bey makroyu denedim ama çalıştıramadım. sürekli hata veriyor .makroyu nasıl çalıştırabilirim.

 

[senerozun]

makro hata vermekte çalıştıramadım . nasıl çalışır hale getirebilirim.