Verileri belirli şartlara göre toplayarak aktarma

[hedjaz]

merhaba,

forumda aktarma tuşu ile ilgili örnekleri inceledim ancak tam olarak istediğimi bulamadım. Ekte paylaştığım örnekte açıklama yapmaya çalıştım. Toplayarak tarihe göre aktarmayı nasıl yapabilirim? Yardımcı olur musunuz?
Teşekkürler.

 

[hedjaz]

Yardımcı olabilecek kimse var mı? Fikir edinebileceğim link te olur.

 

[Necdet]

Merhaba,
Ben hiç bir şey anlamadım.
Sayfa2 deki durumu da belirtirseniz sanırım biraz daha anlaşılır olacak.

 

[HücrelereFısıldayanAdam]

2. Kısımdaki "Tuşa basıldığında C sütunundaki belirtilen tarihin sayfa 2'deki sütunundaki toplam miktarda çıkarsın. Sayfa'de hücre boşsa - olarak belirtsin" cümlesi anlaşılmıyor.
Bence önce kafanızda yapmak istediğiniz şeyi anlatın, çoğu zaman bu işi yapacak daha verimli daha anlamlı yollar olabiliyor çünkü.

 

[hedjaz]

merhaba,

kusura bakmayın. İfadeyi düzgün kuramamışım.

sayfa 1'de girilen verilerin belirttiğim tarihe bağlı olarak sayfa 2'de hangi sütundaysa oraya ilgili ürünün (örneğin X) e-toplamını getirmesi.

 

[Korhan Ayhan]

Her iki buton için aşağıdaki kodu deneyebilirsiniz.

Kod butonlara tıkladığınızda çalışacaktır.

Not : Kod butonlarında üzerinde yazan metinlere göre işlem yapmaktadır. Bu sebeple butonların üzerinde yazan AKTAR ve ÇIKAR kelimelerini değiştirdiğinizde kodu revize etmeniz gerekecektir.

Option Explicit

Sub My_Sumif()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    Dim WF As WorksheetFunction, Bul As Range
    Dim Buton_Text As String, Toplam As Double
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("BRK")
    Set S2 = Sheets("Sayfa2")
    Set WF = WorksheetFunction
    
    Set Bul = S2.Rows(1).Find(S1.Range("C2"), LookAt:=xlWhole)

    Buton_Text = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text

    If Not Bul Is Nothing Then
        For X = 2 To S2.Cells(S2.Rows.Count, 1).End(3).Row
            Toplam = WF.SumIf(S1.Range("A:A"), S2.Cells(X, 1), S1.Range("C:C"))
            If Left(Buton_Text, 5) = "AKTAR" Then
                S2.Cells(X, Bul.Column) = S2.Cells(X, Bul.Column) + Toplam
            ElseIf Left(Buton_Text, 5) = "ÇIKAR" Then
                S2.Cells(X, Bul.Column) = S2.Cells(X, Bul.Column) - Toplam
            End If
        Next
    End If
        
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hedjaz]

Necdet Bey elinize sağlık. Teşekkür ederim.

 

[Necdet]

Necdet Bey elinize sağlık. Teşekkür ederim.

ben sadece sizden daha fazla açıklama istedim, bir şey yapmadım, Korhan beye teşekkür edin.

 

[hedjaz]

haklısınız. karıştırdım. Çok Teşekkürler Korhan Bey.