Makro ile çoketopla işlemi

[ulutanas]

Arkadaşlar merhaba,
sitemizde 3 saat arama yaptım tam istediğim sonucu bulamadım en sonunda konu eklemek zorunda kaldım.

Ekte bulunan deneme dosyasında cari ve firmalar adında 2 sayfa mevcut. Firmalar sayfasında, firmaların cari sayfasında ki hesaplarının toplamlarını çoketopla formülü ile yapabiliyorum, sizlerden ricam bu formülü makro ile yapabilir miyiz ?

Yardımlarınız için şimdiden çok teşekkür ederim.
İyi çalışmalar dilerim...

 

[Ziynettin]

Merhaba,

Tablonuz fazla satır ise bu kodu kullanabilirsiniz.

Sub tablo()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("FİRMALAR")
Set s2 = Sheets("CARİ")
Set d = CreateObject("scripting.dictionary")
a = s2.Range("B2:I" & s2.Cells(Rows.Count, "A").End(3).Row).Value
    For i = 1 To UBound(a)
        d(a(i, 1)) = d(a(i, 1)) + a(i, 8)
    Next i
b = s1.Range("A2:A" & s1.Cells(Rows.Count, "A").End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 1)
    For i = 1 To UBound(b)
        c(i, 1) = d(b(i, 1))
    Next i
s1.[H2].Resize(UBound(b)) = c
End Sub

 

[ulutanas]

Ziynettin bey merhaba,
öncelikle ilginiz için teşekkür ederim. Kendi dosyamda istediğim şekilde tasarladım, fakat her giriş yaptığımda otomatik işlem yapmıyor, her kayıt girildiğinde makroyu çalıştırmam gerekiyor. Bunu otomatik yapma imkanımız var mıdır?

 

[ulutanas]

Arkadaşlar konu güncel

 

[igultekin2000]

Ziynettin bey merhaba,
öncelikle ilginiz için teşekkür ederim. Kendi dosyamda istediğim şekilde tasarladım, fakat her giriş yaptığımda otomatik işlem yapmıyor, her kayıt girildiğinde makroyu çalıştırmam gerekiyor. Bunu otomatik yapma imkanımız var mıdır?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 On Error Resume Next

If Intersect(Target, Range("G1:G1000")) Is Nothing Then Exit Sub
tablo
End Sub

cari sayfanın kod kısmına bunu yapıştırmanız yeterli olur. ancak sürekli giriş yapacaksanız bu uygulama çok pratik olmaz ekteki örneği incelersiniz, fikir açısından

 

[ulutanas]

igultekin2000 merhaba, ilginiz için çok teşekkür ederim.

Şimdi tam istediğim gibi oldu.

İyi çalışmalar dilerim,
Saygılarımla...

 

[ulutanas]

@igultekin2000 merhaba,

Dediğiniz gibi sürekli kayıt yapınca işlem yapmıyor maalesef, ama mutlaka bir çözüm yolu bulunur bu soruna eminim.
İyi çalışmalar dilerim,
Saygılarımla...

 

[igultekin2000]

@igultekin2000 merhaba,

Dediğiniz gibi sürekli kayıt yapınca işlem yapmıyor maalesef, ama mutlaka bir çözüm yolu bulunur bu soruna eminim.
İyi çalışmalar dilerim,
Saygılarımla...

sizin şablonda sorun yok, sorunsuz çalışır, sadece çok pratik kullanamazsınız demek istedim.

 

[Ziynettin]

Firmalar sayfası kod alanına.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 And Target.Row > 1 Then
        Dim s2 As Worksheet
        Set s2 = Sheets("CARİ")
        Set d = CreateObject("scripting.dictionary")
        a = s2.Range("B2:I" & s2.Cells(Rows.Count, "A").End(3).Row).Value
            For i = 1 To UBound(a)
                If a(i, 1) = Target.Value Then
                    d(a(i, 1)) = d(a(i, 1)) + a(i, 8)
                End If
            Next i
        If d.Count > 0 Then
            Target.Offset(, 1) = d(Target.Value)
        Else
            MsgBox "Toplam bulunamadı.", vbCritical
        End If
    End If
End Sub

 

[ulutanas]

@igultekin2000 ve Ziynettin bey merhaba, emeklerinize sağlık şu anda tam istediğim gibi oldu çok teşekkür ederim.

Hayırlı günler dilerim,
Saygılarımla...

 

[KARTAL133]

Merhaba

Aşağıdaki makro çok yavaş çalışıyor daha hızı nasıl ola bilir.

Şimdiden yardımlarınızı için teşekkürler,


Sub Topla()
With Sayfa1

Range("Z3:AE225000").ClearContents

.[Z3:Z26800] = "=if(a3="""","""",if(sum(AB3:AE3)>1,""No"",""Yes""))"
' .[Z3:Z26800].Value = .[Z3:Z26800].Value

.[AA3:AA26800] = "=if(A3="""","""",SUM(T3:Y3))"
.[AA3:AA26800].Value = .[AA3:AA26800].Value

.[AB3:AB26800] = "=if(A3="""","""",SUMIFS(AA:AA,D,D3,Q:Q,""TRY""))"
.[AB3:AB26800].Value = .[AB3:AB26800].Value

.[AC3:AC26800] = "=if(A3="""","""",SUMIFS(AA:AA,D,D3,Q:Q,""USD""))"
.[AC3:AC26800].Value = .[AC3:AC26800].Value


.[AD3:AD26800] = "=if(A3="""","""",SUMIFS(AA:AA,D,D3,Q:Q,""EUR""))"
.[AD3:AD26800].Value = .[AD3:AD26800].Value


.[AE3:AE26800] = "=if(A3="""","""",SUMIFS(AA:AA,D,D3,Q:Q,""GBP""))"
.[AE3:AE26800].Value = .[AE3:AE26800].Value


.[AG3:AG26800] = "=AB3/Webdoviz(today()-1,""USD"",1)+AC3+(AD3*Webdoviz(today()-1,""EUR"",1))/Webdoviz(today()-1,""USD"",1)+(AE3*Webdoviz(today()-1,""GBP"",1))/Webdoviz(today()-1,""USD"",1)"
.[AG3:AG26800].Value = .[AG3:AG26800].Value

.[AH3:AH26800] = "=VLOOKUP(C3,Limit!A:F,6,0)"
.[AH3:AH26800].Value = .[AH3:AH26800].Value

.[AI3:AI26800] = "=VLOOKUP(C3,Limit!A:F,5,0)"
.[AI3:AI26800].Value = .[AI3:AI26800].Value


MsgBox "İşlem tamamlandı." & vbLf & vbLf & _
"İşlem süresi: " & Format(Timer - Zaman, "00.000") & " saniye.", vbInformation, "..:: ::.."

End With
End Sub

 

[excelin kurdu]

Merhaba.
Benimde ekte verildiği gibi bir üretim dosyam var. Üretim takibi adındaki sayfaya birimlerde yapılan üretim adeti ve işlemeden önce ve işlemeden sonra redleri çoketopla formülüyle alıyorum ama bu seferde dosya çok yavaşlıyor ve açılmıyor. Çoketopla formülü yerine bir makro yazabilir misiniz? Her iş emri numarasına karşılık kalıplanan taşlanan eritilen işlenen üretim adeti ve redleri gelsin istiyorum. Ama nasıl yapabilirim bilmiyorum.

Yardımlarınız için şimdiden teşekkür ederim