Çoketopla Makro

KARTAL133 · 5 Aralık 2018

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

.[o4

70000] = "=(c4-h4)"
.[o4

70000].Value = .[o4

70000].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

.[p4

70000] = "=(d4-ı4)"
.[p4

70000].Value = .[p4

70000].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 · 5 Aralık 2018

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

Erdem Akdemir · 5 Aralık 2018

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

KARTAL133 · 5 Aralık 2018

Merhaba

Örnek Dosya Ektedir.

Merhum İdris SERDAR · 5 Aralık 2018

.

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 · 5 Aralık 2018

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

Erdem Akdemir · 5 Aralık 2018

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 · 5 Aralık 2018

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 · 6 Aralık 2018

Erdem Bey

Bak bildiniz mi?

turist · 6 Aralık 2018

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

Kod:

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 · 6 Aralık 2018

çok teşekkürler

ancak pc kasıyor

Erdem Akdemir · 7 Aralık 2018

Merhaba,

Aşağıdaki kodu dener misiniz.

Kod:

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 · 7 Aralık 2018

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

Erdem Akdemir · 7 Aralık 2018

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

KARTAL133 · 7 Aralık 2018

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

KARTAL133 · 7 Aralık 2018

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 · 8 Aralık 2018

Alternatif.

Kod:

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 · 8 Aralık 2018

Merhaba

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

Ziynettin · 8 Aralık 2018

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

KARTAL133 · 10 Aralık 2018

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.

Çoketopla Makro

KARTAL133

Muzaffer Ali

Destek Ekibi

Erdem Akdemir

Destek Ekibi

KARTAL133

Ekli dosyalar

Merhum İdris SERDAR

Moderatör

KARTAL133

Erdem Akdemir

Destek Ekibi

KARTAL133

KARTAL133

turist

Destek Ekibi

KARTAL133

Ekli dosyalar

Erdem Akdemir

Destek Ekibi

KARTAL133

Erdem Akdemir

Destek Ekibi

KARTAL133

KARTAL133

Ziynettin

Destek Ekibi

Ekli dosyalar

KARTAL133

Ziynettin

Destek Ekibi

KARTAL133

Ekli dosyalar