Döngü ile toplam yaptırma

[serhatyrdmc]

Makro'da kod yazmak istediğim 2 adet örneği dosya olarak ekledim,soru açıklamaları içinde mevcuttur.Bu konuda yardımcı olursanız memnun olurum

 

[asi_kral]

Merhaba
1. Sorunuzu formül çok rahat yapar makro ile istemenizin sebebi nedir.
2. Sorunuzda örnek verdiğiniz değerdeki rakamı nasıl buldunuz.
Örneklerin birinde 4 diğerinde 1 yazıyor toplamı 6 nasıl olmuş.
4 + 1 = 5
4 - 1 = 3
4 * 1 = 4
4 / 1 = 4
Olanlardan biri olmalı diye düşünüyorum.

 

[Korhan Ayhan]

Merhaba,

Kodlar örnek dosyanıza göre tasarlanmıştır. Kendi orjinal dosyanıza göre uyarlarsınız.

1. Sorunuz için;

Sub Makro_1()
    Dim X As Integer
    
    For X = 5 To 11
        If Cells(X, "D") = "X" Then
            If Cells(X, "E") <> "" Then
                Cells(X, "O") = WorksheetFunction.Sum(Range("D" & X & ":N" & X))
            Else
                Cells(X, "O") = ""
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

2. Sorunuz için;

Sub Makro_2()
    Dim Alan1 As Range
    Dim Alan2 As Range
    Dim Alan3 As Range
    Dim Tum_Alan As Range
    Dim Veri As Range
    Dim Satir As Integer
    Dim Bul As Range
    Range("O30:P43").ClearContents
    Satir = 30
    
    Set Alan1 = Range("E30:E" & Cells(Rows.Count, "E").End(3).Row)
    Set Alan2 = Range("H30:H" & Cells(Rows.Count, "H").End(3).Row)
    Set Alan3 = Range("K30:K" & Cells(Rows.Count, "K").End(3).Row)
    Set Tum_Alan = Union(Alan1, Alan2, Alan3)
    
    For Each Veri In Tum_Alan
        If Veri.Value <> "" Then
            If WorksheetFunction.CountIf(Range("O30:O42"), Veri.Value) = 0 Then
                Cells(Satir, "O") = Veri.Value
                Cells(Satir, "P") = Veri.Offset(0, 1)
                Satir = Satir + 1
            Else
                Set Bul = Range("O30:O42").Find(Veri.Value, , , xlWhole)
                Cells(Bul.Row, "P") = Cells(Bul.Row, "P") + Veri.Offset(0, 1)
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[serhatyrdmc]

Korhan Bey ilgi alakanız için teşekkür ederim,verdiğiniz kodları gönderdiğim soru örneğine göre uygun çalışıyor ancak bazı konumlandırmaları yanlış göstermişim,kodları yeni konumlara göre uyarlamaya çalıştım, yapamadım,örnegi aşagıda tekrar yolladım,yardımcı olabilirseniz memnun olurum,şimdiden teşekkürler