Veri Giriş Excel / Macro Dönüşümü hk.

[kartal76]

İleti ekinde ürün satış ve stok takibi ile ilgili bir çalışmamı gönderiyorum. Topla.Çarpım ile düzenlediğim tablo şu an yaklaşık 2.50 MB boyutuna ulaştı. Bu sebeple, "Veri Giriş" sayfasında her bilgi girişimde pc yavaş işlem yapmaya başladı.

Gelecek günlerde çalışmanın üzerinde istatistik oluşturma, grafik ve rapor gibi ilave çalışma sayfaları ekleyecek olmam sebebiyle, sanırım dosya boyutu çok daha büyüyecek ve pc çok daha yavaş işlem yapacak.

PC' yi daha seri işlem yapacak hale getirmek için, Topla.Çarpım ile düzenlenen tabloyu, makrolu hale nasıl dönüştürebilirim?

Konu ile ilgili öneri veya başka fikri olan arkadaşlar paylaşırlarsa memnun olurum.

İyi çalışmalar..

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub HESAPLA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim HÜCRE As Range
    Dim BUL As Range, ADRES As String
    Dim KRİTER As Range
 
    Set S1 = Sheets("Veri Giriş")
    Set S2 = Sheets("Veri")
 
    Application.ScreenUpdating = False
 
    S2.Range("B3:M52").ClearContents
 
    For Each HÜCRE In S2.Range("A3:A52")
        Set BUL = S1.[B:B].Find(HÜCRE.Value)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
 
    If S1.Cells(BUL.Row, 3) = S2.Range("B1") Then
        For Each KRİTER In S2.Range("B2:G2")
        If KRİTER.Value = S1.Cells(BUL.Row, 4) Then
        S2.Cells(HÜCRE.Row, KRİTER.Column) = S2.Cells(HÜCRE.Row, KRİTER.Column) + S1.Cells(BUL.Row, 5)
        Exit For
        End If
        Next
 
    ElseIf S1.Cells(BUL.Row, 3) = S2.Range("H1") Then
        For Each KRİTER In S2.Range("H2:M2")
        If KRİTER.Value = S1.Cells(BUL.Row, 4) Then
        S2.Cells(HÜCRE.Row, KRİTER.Column) = S2.Cells(HÜCRE.Row, KRİTER.Column) + S1.Cells(BUL.Row, 5)
        Exit For
        End If
        Next
    End If
 
        Set BUL = S1.[B:B].FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
 
    Set BUL = Nothing
 
    S2.Select
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kartal76]

Teşekkürler..

Sn.Ayhan,

Bayram günü zamanınızı ayırıp sorumla ilgilenip, cevap verdiğiniz için teşekkür ederim. Benim için önemli bir sorunun çözümünde çok faydası olacak. Sağolun..

"Hesapla" ikonunu kullanmadan direkt sonuç elde etmek mümkün olabilir mi? (Umarım yüzsüzlük olmaz )

Şaka bir yana; tekrar emeğinize sağlık..

İyi bayramlar dilerim..

 

[tahsinanarat]

Sayfa2 de ENTER tuşuna basın

Sayfa2 ye geçtip ENTER tuşuna bastığınızda makronuz çalışacaktır.

 

[kartal76]

Sn.tahsinanarat,

Öneriniz için teşekkür ederim. Ancak Sayfa2' ye (benim "Veri" sayfasına) geçip enter yaptığım zaman birşey elde edemedim. Yapılış şeklinden bahsedebilir misiniz? Sanırım yanlış yaptığım birşey var..

 

[tahsinanarat]

Entera basınca dosya çalışsın

Sn. Kartal76 bir önceki mesajımda yaptığım dosyayı eklediğimi zannederek cevap yazmışım, özür dilerim. Uyarınız için teşekkür ederim. Dosyanız ektedir. Kolay gelsin.

 

[kartal76]

Sn.tahsinarat,

İlgi ve yardımınız için teşekkür ederim. Çok makbule geçti doğrusu.

Emeğinize sağlık..