ÇOKETOPLA YI VBA DA UYGULAMAK

[hgenc545]

Sub FormülüYaz()
Dim ws1 As Worksheet: Set ws1 = Sheets("Transfer data")
Dim sonsatır As Long: sonsatır = ws1.Range("A1000000").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ws1.Range("l2:m" & sonsatır)
.ClearContents
End With
With ws1.Range("l2:l" & sonsatır)
.Formula = "=SUMIFS(Rapor!G:G,Rapor!F:F,'Transfer data'!G2,Rapor!D,'Transfer data'!C2,Rapor!C:C,'Transfer data'!F2,Rapor!B:B,'Transfer data'!B2,Rapor!A:A,'Transfer data'!A2)"
.Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Merhabalar,

Çok yoğun olduğundan dolayı çoketopla işlemini sitenizdeki destekle yukarıdaki VBA kodlar ile yapmıştık.
Çünkü formülize edip tüm satırlara uyguladığımda donuyordu excel.

Ama maalesef bu şekilde de kasıyor, donuyor. Dosyam aşağıdaki linkteki gibidir. 50bin satırlı, hatta 300bin satırlada çalışıyorum bazen.
Bunu nasıl olurda kasmayan hale getirebiliriz. Alternatifiniz varmı, çoketopladaki işlem sonucu olması gerekiyor. Destek ricası ile..


VBA lı örnek dosyam
https://wetransfer.com/downloads/84e1d07253943cad387759d042a44e8720181007205825/b90a36992dbbd1bca4f6676b6e9d93ee20181007205825/d41b7f

 

[kemalist]

Sub FormülüYaz()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim ws1 As Worksheet: Set ws1 = Sheets("Transfer data")
Dim sonsatır As Long: sonsatır = ws1.Range("A1000000").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ws1.Range("l2:m" & sonsatır)
.ClearContents
End With
With ws1.Range("l2:l" & sonsatır)
.Formula = "=SUMIFS(Rapor!G:G,Rapor!F:F,'Transfer data'!G2,Rapor!D,'Transfer data'!C2,Rapor!C:C,'Transfer data'!F2,Rapor!B:B,'Transfer data'!B2,Rapor!A:A,'Transfer data'!A2)"
.Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Yukarıdaki kırmızı olan yerleri kopyalayıp yapıştırın veya tamamını kopyalayıp yapıştırın.

 

[Ömer BARAN]

Merhaba.

Eklenen belgeye bakıp, her iki sayfada verileri, formüldeki sorgu kriterlerine göre kontrol ettiğimde,
sayfadaki verilerin kriterler bakımından pek tekrarlanmadığını (yani benzersiz olduğunu) gördüm.
Gerçek belgedeki durumu elbette bilemiyoruz ama en azından fikrimi belirteyim.

--Kriterlere göre her iki sayfaya basit birleştirme formülü uygulayıp DEĞERe dönüştürülür,
(Transfer sayfasında M sütununa =A2&B2&F2&C2&G2 ve Raporsayfasında da aynı sırayla olmak üzere H sütununa =A2&B2&C2&D2&F2)
-- Ardından da bu iki sayfa formüllerin uygulandığı sütunlara (M ve H) göre sıralanır,
-- Yukarıdaki işlem sonuçlarından hareketle;
... Birinde olup diğerinde olmayanlar için doğrudan 0 yazdırılabilir,
... Tek olan değerlerin varlığı kontrol edilerek bunlar için ÇOKETOPLA formülü uygulanmayıp doğrudan mevcut değer yazdırılabilir,
... Kalan satırlar için de herbir ürün için formül alanı (yani satır sayısı) daraltılabilir, hatta yanlış düşünmüyorsam ETOPLA işleviyle de sonuç alınabilir.

Bu şekilde işlemin daha hızlı olabileceğini düşünüyorum.
Üstünde çalışılması gereken bir konu bence. Belki de ÖZET TABLO seçeneği üzerinde durmak gerekir.
Bunlardan hangisinin tercih edileceği, gerçek belgedeki veri yapısına göre değişibilir diye düşünüyorum.
.

 

[Ziynettin]

Mergaba,

"scripting.dictionary" metodu ile yapılan çalışma. Bu şekilde deneyiniz.

Sub topla()
Dim wT As Worksheet, wR As Worksheet
Dim a(), b(), c(), d As Object
Dim i As Long, deg As Variant
Set wT = Sheets("Transfer data")
Set wR = Sheets("Rapor")
Set d = CreateObject("scripting.dictionary")
Z = TimeValue(Now)

a = wR.Range("A2:G" & wR.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 1 To UBound(a)
        deg = a(i, 1) & a(i, 2) & a(i, 3) & a(i, 4) & a(i, 6)
        d(deg) = d(deg) + CDbl(a(i, 7))
    Next i
   
    b = wT.Range("A2:G" & wT.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim c(1 To UBound(b), 1 To 1)
    For i = 1 To UBound(b)
        deg = b(i, 1) & b(i, 2) & b(i, 6) & b(i, 3) & b(i, 7)
        c(i, 1) = CDbl(d(deg))
    Next i
   
    wT.[P2].Resize(UBound(b)) = c
   
MsgBox "İşlem tamam." & vbLf & vbLf & CDate(TimeValue(Now) - Z), vbCritical
End Sub

wT.[P2].Resize(UBound(b)) = c Veriler sonuç kontrolu için P sütununa yazdırıldı. Kırmızı yazılı yeri kendinize göre düzenlersiniz.

Stok transfer: dosya

 

[guderm]

Arkadaşlar,
ÇOKETOPLA ile ilgili olarak;
VeriData ve Rapor diye iki ayrı dosyam mevcut.
Rapor dosyasına VeriData dan ÇOKETOPLA ile (birden çok değişken olduğundan) verileri Rapor dosyasına getiriyorum. Fakat veridata dosyası kapalı iken verileri alamıyorum. Veri yerine #DEĞER hatası veriyor. VBA da yapabilirmiyiz. Yada ÇOKETOPLA ile kapalı bir dosyadan verileri nasıl getirtebilirim.