Çoketopla Makro

[KARTAL133]

Merhaba arkadaşlar

makro ile çoketopla formulu yaptım.
ancak excel çok kasıyor. işlevi uzun sürüyor.
yardımlarınızı rica ederim.


Sub vade_hesap()
With Sayfa3

Range("b4:R70000").ClearContents

.[b4:b70000] = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$b$3))"
.[b4:b70000].Value = .[b4:b70000].Value

.[g4:g70000] = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$g$3))"
.[g4:g70000].Value = .[g4:g70000].Value

.[n4:n70000] = "=(b4-g4)"
.[n4:n70000].Value = .[n4:n70000].Value



.[c4:c70000] = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$c$3))"
.[c4:c70000].Value = .[c4:c70000].Value

.[h4:h70000] = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$h$3))"
.[h4:h70000].Value = .[h4:h70000].Value

.[o470000] = "=(c4-h4)"
.[o470000].Value = .[o470000].Value


.[d4:d70000] = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$d$3))"
.[d4:d70000].Value = .[d4:d70000].Value

.[ı4:ı70000] = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$ı$3))"
.[ı4:ı70000].Value = .[ı4:ı70000].Value

.[p470000] = "=(d4-ı4)"
.[p470000].Value = .[p470000].Value


.[e4:e70000] = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$e$3))"
.[e4:e70000].Value = .[e4:e70000].Value

.[j4:j70000] = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$j$3))"
.[j4:j70000].Value = .[j4:j70000].Value


.[q4:q70000] = "=(e4-j4)"
.[q4:q70000].Value = .[q4:q70000].Value



.[l4:l70000] = "=VLOOKUP(A4,'isis'!d:al,29,0)"
.[l4:l70000].Value = .[l4:l70000].Value

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

End With
End Sub

 

[Muzaffer Ali]

Kodlarınızın en başına
Application.Calculation = xlCalculationManual
en sonuna da
Application.Calculation = xlCalculationAutomatic
satırlarını ekleyip dener misiniz?

 

[Erdem Akdemir]

Örnek dosyanızı eklerseniz. Daha hızlı çalışan çözümler sunulabilir.

 

[KARTAL133]

Merhaba

Örnek Dosya Ektedir.

 

[Merhum İdris SERDAR]

.

Formüllerin içindeki alanları sınırlarını belirleyin.

Örneğin,

=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$b$3))" olanı

=(SUMIFS('isis'!$AB4:$AB70000,'isis'!$d4:$d70000,a4,'isis'!$c4:$c70000,$b$3))"

şeklinde yaparak deneyin.

.

 

[KARTAL133]

ilgili sınırlamayı yaptım ama sonuç aynı

 

[Erdem Akdemir]

Kartal bey,

Eklediğiniz dosyayı çalıştırdığımda hiç tutar gelmiyor.
Kendi belirlediğiniz ID'lerin mi toplamanı istiyorsunuz,tüm listenin mi?
isis ile rapor arasındaki ortak nokta nedir.

 

[KARTAL133]

Merhaba Erdem Bey
Önceki Yazdığım excelde Trx Number numarlarını yanlış yazdığım için tutar gelmiyordu.
aşağıdaki gibi düzeltiğimde geliyor.

Ama Aynı fat. sisteme islenip işlenmediği işlendi ise arasında farkı veya red edilen var mı yok
kontrolu sağlamak
simdiden yardımlarını için teşekkürler

 

[KARTAL133]

Erdem Bey

Bak bildiniz mi?

 

[turist]

Kodunuzu aşağıdaki gibi uygulayıp deneyin.

Sub vade_hesap()
    With Sayfa3
    son = Cells(Rows.Count, 1).End(xlUp).Row
    Range("b4:R70000").ClearContents
    
        .Range("b4:b" & son) = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$b$3))"
        .Range("b4:b" & son).Value = Range("b4:b" & son).Value
        
        .Range("g4:g" & son) = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$g$3))"
        .Range("g4:g" & son).Value = .Range("g4:g" & son).Value
                
        .Range("n4:n" & son) = "=(b4-g4)"
        .Range("n4:n" & son).Value = .Range("n4:n" & son).Value
                
                
        
        .Range("c4:c" & son) = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$c$3))"
        .Range("c4:c" & son).Value = .Range("c4:c" & son).Value
                
        .Range("h4:h" & son) = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$h$3))"
        .Range("h4:h" & son).Value = .Range("h4:h" & son).Value
                
         .Range("o4:o" & son) = "=(c4-h4)"
         .Range("o4:o" & son).Value = .Range("o4:o" & son).Value
                
              
        .Range("d4:d" & son) = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$d$3))"
        .Range("d4:d" & son).Value = .Range("d4:d" & son).Value
        
        .Range("ı4:ı" & son) = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$ı$3))"
        .Range("ı4:ı" & son).Value = .Range("ı4:ı" & son).Value
        
         .Range("p4:p" & son) = "=(d4-ı4)"
        .Range("p4:p" & son).Value = .Range("p4:p" & son).Value

                
        .Range("e4:e" & son) = "=(SUMIFS('isis'!$AB:$AB,'isis'!$d:$d,a4,'isis'!$c:$c,$e$3))"
        .Range("e4:e" & son).Value = .Range("e4:e" & son).Value
    
        .Range("j4:j" & son) = "=(SUMIFS('rapor'!$ac:$ac,'rapor'!$o:$o,a4,'rapor'!$z:$z,$j$3))"
        .Range("j4:j" & son).Value = .Range("j4:j" & son).Value
        
        
        .Range("q4:q" & son) = "=(e4-j4)"
        .Range("q4:q" & son).Value = .Range("q4:q" & son).Value
            
        

         .Range("l4:l" & son) = "=VLOOKUP(A4,'isis'!d:al,29,0)"
         .Range("l4:l" & son).Value = .Range("l4:l" & son).Value
            
     MsgBox "İşlem tamamlandı." & vbLf & vbLf & _
        "İşlem süresi: " & Format(Timer - Zaman, "0.00") & "  saniye.", vbInformation, "..:: Murat Esen ::.."

    End With
End Sub

 

[KARTAL133]

çok teşekkürler

ancak pc kasıyor

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu dener misiniz.

Sub ddeeee()

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "transform sum(PayableAmount) select DocumentNo from[isis$] group by DocumentNo pivot DocumentCurrencyCode"
Set rs = con.Execute(sorgu)
Sayfa3.Rows("4:100000").Clear
Sayfa3.Application.Union(Sayfa3.Range("B3:E3"), Sayfa3.Range("g3:j3"), Sayfa3.Range("n3:q3")).ClearContents

x = 1
For Each deg In rs.Fields
On Error Resume Next
Sayfa3.Cells(3, x + 1) = rs.Fields.Item(x).Name
Sayfa3.Cells(3, x + 6) = rs.Fields.Item(x).Name
Sayfa3.Cells(3, x + 13) = rs.Fields.Item(x).Name
x = x + 1
Next deg

Sayfa3.Range("A4").CopyFromRecordset rs
con.Close

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
son = Sheets("Karsılastırma").Cells(Rows.Count, "a").End(3).Row

sorgu = "select rapor.[Transaction Receivable Amount] from[Karsılastırma$A3:A" & son & "] Karsılastırma left join [rapor$] rapor on Karsılastırma.[Taxnumber] = rapor.[Trx Number] "

Set rs = con.Execute(sorgu)
Range("G4").CopyFromRecordset rs
End Sub

 

[KARTAL133]

denedim ancak sadece isis teki rakamlar geliyor rapor kısmındakiler gelmiyor

 

[Erdem Akdemir]

Örnek dosyanızda çalıştı.65500 satırdan fazlamı veri var.Çalışmayan dosyayı görmeden kesin yorum yapıyorum.

 

[KARTAL133]

Merhaba
Hesaplama çok hızlı kasma yok ancak Rapor kısmında tutar gelmiıyor
aşağıdaki gibi oluyor

 

[KARTAL133]

Sorunun ne olduğunu buldum.
çözdüm ancak İsis te USD - TRY - GBP - EUR tutarları geliyor ancak
rapor kısmında sadece butun para bırımlerını EUR yazıyor
ayıca bendeki veri 80000 kadar 65000 den sonrasını hesaplamıyor
neden hesaplamadığını bulamadım



Sorun
Aşağıdaki sorun düzelttikten sonra çözüldü.

Karsılastırma.[Taxnumber] = " olması gereken

Karsılastırma.[Trx number] =" yanlış olan

 

[Ziynettin]

Alternatif.

Private Sub CommandButton1_Click()
Set s1 = Sheets("isis")
Set s2 = Sheets("rapor")
Set s3 = Sheets("Karsılastırma")
Z = TimeValue(Now)
Set dic = CreateObject("scripting.dictionary")
    a = s1.Range("C2:AB" & s1.Cells(Rows.Count, 3).End(3).Row).Value
    b = s2.Range("O2:AC" & s2.Cells(Rows.Count, "O").End(3).Row).Value
    son_sat = UBound(a) + UBound(b)
    
    ReDim c(1 To son_sat, 1 To 10)
    ReDim c1(1 To son_sat, 1 To 4)
    
    For i = 1 To UBound(a)
        krt = a(i, 2)
        If Not dic.exists(krt) Then
            say = say + 1
            dic(krt) = say
            sat = say
        Else
            sat = dic(krt)
        End If
        c(sat, 1) = krt
        If a(i, 1) = "TRY" Then c(sat, 2) = c(sat, 2) + CDbl(a(i, 26)) Else c(sat, 2) = 0
        If a(i, 1) = "USD" Then c(sat, 3) = c(sat, 3) + CDbl(a(i, 26)) Else c(sat, 3) = 0
        If a(i, 1) = "EUR" Then c(sat, 4) = c(sat, 4) + CDbl(a(i, 26)) Else c(sat, 4) = 0
        If a(i, 1) = "GBP" Then c(sat, 5) = c(sat, 5) + CDbl(a(i, 26)) Else c(sat, 5) = 0
    Next i
    
    For i = 1 To UBound(b)
        krt1 = b(i, 1)
        If Not dic.exists(krt1) Then
            say = say + 1
            dic(krt1) = say
            sat = say
        Else
            sat = dic(krt1)
        End If
        c(sat, 1) = b(i, 1)
        If b(i, 12) = "TRY" Then c(sat, 7) = c(sat, 7) + b(i, 15) Else c(sat, 7) = 0
        If b(i, 12) = "USD" Then c(sat, 8) = c(sat, 8) + b(i, 15) Else c(sat, 8) = 0
        If b(i, 12) = "EUR" Then c(sat, 9) = c(sat, 9) + b(i, 15) Else c(sat, 9) = 0
        If b(i, 12) = "GBP" Then c(sat, 10) = c(sat, 10) + b(i, 15) Else c(sat, 10) = 0
        c1(sat, 1) = c(sat, 2) - c(sat, 7)
        c1(sat, 2) = c(sat, 3) - c(sat, 8)
        c1(sat, 3) = c(sat, 4) - c(sat, 9)
        c1(sat, 4) = c(sat, 5) - c(sat, 10)
    Next i
    s3.[A4].Resize(dic.Count, 10) = c
    s3.[N4].Resize(dic.Count, 4) = c1
MsgBox "İşlem tamam." & vbLf & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

 

[KARTAL133]

Merhaba

Çok teşekkürler
istediğim gibi olmuş

 

[Ziynettin]

Rica ederim...İyi çalışmalar....

 

[KARTAL133]

Ziynettin bey Merhaba

Başka bir sorun cıktı
fat. listesini güncelledim. isis te toplam 80000 kadar geldi.
Fat. numaraları geliyor ancak fat. tutarı gelmiyor. en son 68333 kadar geliyor gerisi yok
ama rapor kısmında hepsini hesaplıyor. sorun araştırdım ama bulamadım.
yardımcı ola bilirsen sevinirim.