Makro ile Matematiksel işlem

[Yesilyurtlu]

Değerli Uzmanlarım;

Excel de hani formül ile yüzde alma, Çarpma, Bölme, Toplama (Yatay ve Dikey olarak) az çok yapabiliyoruz. Ama kısa öz olan MAKRO ile nasıl yapılabilir?

MAKRO konusunda ÜSTAD olan uzmanlarım bu konuda örnekli bir dosya ekleyebilir mi?

Elimizde kaynak olması açısından istirham ediyorum

 

[N.Ziya Hiçdurmaz]

yanıt

Sub toplamal1()
[C2] = Empty
[C2] = WorksheetFunction.Sum(Range("a2:a1000"))
End Sub

Sub toplam2()
Dim sat As Integer
[d2] = Empty
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        [d2] = [d2] + Cells(sat, "A")
    Next
End Sub

Sub toplam3()
Dim sat As Integer
[E2] = Empty
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        If Cells(sat, "A").Interior.Color = [E2].Interior.Color Then
            [E2] = [E2] + Cells(sat, "A")
        End If
    Next
End Sub

Sub toplam4()
Dim sat As Integer
[F2] = Empty
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        If Cells(sat, "A").Interior.ColorIndex = 6 Then
            [F2] = [F2] + 1
        End If
    Next
End Sub

Sub toplam5()
On Error GoTo HATA
Dim ARALIK As String
[G2] = Empty
ARALIK = InputBox("Bir aralık yazınız.'A1:A10' gibi")
    [G2] = WorksheetFunction.Sum(Range(ARALIK))
Exit Sub
HATA:
MsgBox "Aralık seçiniz", vbInformation
End Sub

Sub topla6()
[C2] = WorksheetFunction.SumIf([A2:A20], ">12")
End Sub

Sub topla7()
[d2] = Empty
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        If Cells(sat, "A") > 10 Then
            [d2] = [d2] + Cells(sat, "A")
        End If
    Next
End Sub

Sub topla8()
[E2] = Empty
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        If Cells(sat, "A") > 12 And Cells(sat, "A") < 20 Then
            [E2] = [E2] + Cells(sat, "A")
        End If
    Next
End Sub

Sub dolusay1()
[C2] = WorksheetFunction.CountA([a1:a20])
End Sub

Sub bossay1()
[d2] = WorksheetFunction.CountBlank([a1:a20])
End Sub

Sub egersay1()
[C2] = WorksheetFunction.CountIf([a1:a50], "OCAK")
End Sub

Sub egersay2()
[d2] = WorksheetFunction.CountIf([B1:B50], ">5")
End Sub

Sub ortalama1()
[C2] = WorksheetFunction.Average([A2:A20])
End Sub

Sub ortalama2()
SAY = WorksheetFunction.CountA([A2:A20])
[d2] = WorksheetFunction.Sum([A2:A20]) / SAY
End Sub

Sub enkucuk1()
[C2] = WorksheetFunction.Min([A2:A20])
End Sub

Sub enbuyuk1()
[d2] = WorksheetFunction.Max([A2:A20])
End Sub

Sub bul1()
On Error Resume Next
deg = InputBox("Aranılan değeri yazınız.")
Cells.Find(deg).Activate
End Sub

Sub duseyara1()
Dim sat As Integer
On Error Resume Next
    For sat = 2 To Cells(65536, "A").End(xlUp).Row
        Cells(sat, "E") = WorksheetFunction.VLookup(Cells(sat, "D"), _
        Range("A:B"), 2, 0)
    Next
End Sub

Sub ayir1()
    For sat = 2 To Cells(65536, "a").End(xlUp).Row
        Cells(sat, "b") = Split(Cells(sat, "a"), " ")(0)
    Next
End Sub

Sub ayir2()
    For sat = 2 To Cells(65536, "a").End(xlUp).Row
        Cells(sat, "c") = Split(Cells(sat, "a"), " ")(1)
    Next
End Sub

 

[Yesilyurtlu]

ÜSTADIM teşekkür ettim

 

[tugi56]

ellerinize sağlık
nasıl çalışır ne işe yarar
kısa ve öz bir dosya eklenirse bence iyi olur