• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile Düşeyara ve Etopla nasıl yapılır

Katılım
8 Eylül 2015
Mesajlar
71
Excel Vers. ve Dili
2010 - Türkçe
Herkese selamlar,
Soracağım soru çok kolay olabilir ama Excel'de makro kullanımını daha yeni öğrenmeye başladım.
Elimde bir dosya var. yaklaşık 1 milyon satır.
Düşeyara ve etopla yaptığımda işlem çok uzun sürüyor.
Bu işlemleri makroda nasıl yazabilirim acaba? Bir de yaptığınız işlemleri anlatmanızı rica edeceğim :)
"Veri 2" çalışma sayfasına "Veri 1" den düşeyara ile "Mağaza sınıfı" nı getiriyorum.
"Veri 2" deki "Toplam" sütununa da Etopla formülü ile "Veri 1" deki değerlerin toplamını getiriyorum.
İsteğim "Makro" çalışma sayfasına aynı işlemleri makro ile yapmak

Örnek dosya linki aşağıdadır
Herkese şimdiden çok teşekkür ederim

https://drive.google.com/file/d/0B6jo34yj3V6rSi00N255VldKR2M/view?usp=sharing
 
Merhaba,

Dosyanız ekte.

Kod:
Option Explicit
Sub Topla()
Dim a(), b(), t(), c(), d As Object
Dim i As Long, Say As Long, Krt, Zaman As Double
Dim s1 As Worksheet, s2 As Worksheet
    Zaman = TimeValue(Now)
    Set s1 = Sheets("VERİ 1")
    Set s2 = Sheets("MAKRO")
    Set d = CreateObject("Scripting.Dictionary")
    a = s1.Range("A2:C" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim t(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        Krt = a(i, 1)
        If Not d.exists(Krt) Then
            Say = Say + 1
            d.Add Krt, Say
            t(Say, 1) = a(i, 2)
        End If
            t(d(Krt), 2) = t(d(Krt), 2) + a(i, 3)
    Next i
    
On Error Resume Next

    b = s2.Range("B2:B" & s2.Cells(Rows.Count, 2).End(3).Row).Value
    ReDim c(1 To UBound(b), 1 To 2)
    Say = 0
    For i = 1 To UBound(b)
        Say = Say + 1
        If b(i, 1) <> "" Then
            c(Say, 1) = t(d(b(i, 1)), 1)
            c(Say, 2) = t(d(b(i, 1)), 2)
        End If
    Next i
Application.ScreenUpdating = False
    s2.Range("D2:E" & Rows.Count).ClearContents
    s2.[D2].Resize(Say, 2) = c
Application.ScreenUpdating = True
MsgBox "İşleminiz Tamam....." & vbLf & "İşlem sürneiz :  " & _
        CDate(TimeValue(Now) - Zaman), vbInformation
End Sub




http://s2.dosya.tc/server3/bu8tj4/EXCEL.rar.html
 

Ekli dosyalar

Öncelikle çok teşekkür ederim. Sadece düşeyara formülünü makro ile yazmak istesem nasıl yazarım
 
Rica ederim.

Tablonuzun 1 (Bir) milyon satırdan fazla olduğunu belirttiğiniz için bu kodu yazdım hızlı sonuç alabilmeniz için.

Düşeyara (VLookup) ile bu kadar hızlı sonuç alamazsınız.

Vakit bulduğumda dönüş yaparım.
 
Çok teşekkür ederim tekrar. Sütunların yeri değişebiliyor. Mantığını ondan öğrenmek istiyorum.
 
Geri
Üst