• DİKKAT

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

yavaş çalışma

onur3466

Altın Üye
Katılım
31 Ağustos 2019
Mesajlar
190
Excel Vers. ve Dili
Ofis 2019 TR
Merhaba arkadaşlar,
Makro kodları kullanarak bir takip dosyası oluşturdum. Ancak veri girişi yaptığımda Excel ciddi şekilde yavaşlıyor; hücreler arasında geçişlerde dahi donmalar ve gecikmeler yaşıyorum. Bu konuda tecrübelerinizi ve desteklerinizi rica ederim.
 

Ekli dosyalar

Merhaba,

Formüllerde hücre aralığı olarak A:A gibi kullanmışsınız. Bu aralıkları küçültmeyi deneyebilirsiniz.

Ayrıca formüllerde SIFIR sonuçlarını gizlemek için ikili formül yazım tekniğini kullanmışsınız. Bunun yerine biçimlendirme ya da koşullu biçimlendirme kullanabilirsiniz. Ayrıca excel seçeneklerinden sıfırları gizleyebilirsiniz. Böylece formüllerde ki ikili yazım tekniğini iptal edebilirsiniz. Bu sayede dosyadaki formül yükü azalacaktır.

Ayrıca hesaplama yöntemini "ELLE" şeklinde ayarlayarak çalışmayı veri girişi anında hızlandırabilirsiniz.
 
Korhan Bey, denedikten sonra tekrar sizinle iletişime geçeceğim. İlginiz ve desteğiniz için şimdiden teşekkür ederim.
 
Formülsüz makro ile yapılan çalışma.

Kod:
Sub veri_Al()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim dc As Object
    
    Set ws1 = Sheets("VERİ GİRİŞİ")
    Set ws2 = Sheets("TAKVİM")
    Set dc = CreateObject("scripting.dictionary")

    h = ws2.[H3]
    y = ws2.[B2]
    xx = DateSerial(y, 1, 1)
    yy = xx - Weekday(xx, 3) + (h - 1) * 7

    For j = 1 To 5
      ws2.Cells(5, j + 1) = DateAdd("d", j - 1, yy)
    Next j
    For j = 1 To 3
      ws2.Cells(4, j + 6) = h & "-NOT" & j
    Next j

    son1 = ws1.Range("A" & Rows.Count).End(3).Row
    son2 = ws2.Range("A" & Rows.Count).End(3).Row + 1

    If son2 < 7 Then Exit Sub
    If son1 < 2 Then Exit Sub

    ar1 = ws1.Range("A1:D" & son1).Value
    For i = 2 To UBound(ar1)
        krt = ar1(i, 1) & "|" & ar1(i, 4)
        dc(krt) = i
    Next i

    ar2 = ws2.Range("A4:I" & son2).Value
    ReDim tbl(1 To UBound(ar2), 1 To 8)
    For i = 3 To UBound(ar2)
        say = say + 1
        For j = 1 To 8
            If j + 1 <= 6 Then sat = 2 Else sat = 1
            krt = ar2(i, 1) & "|" & ar2(sat, j + 1)
            If dc.exists(krt) Then
                tbl(say, j) = ar1(dc(krt), 3)
                tbl(say + 1, j) = ar1(dc(krt), 2)
            End If
        Next j
    Next i

    ws2.[B6].Resize(say + 1, 8) = tbl
End Sub
 

Ekli dosyalar

Öncelikle yurt dışında sahada bulunduğum için zamanında geri dönüş yapamadığım için özür dilerim. Elinize emeğinize sağlık Ziynettin bey. Fakat veri girişine girilen verilerde "Not" kısımları gelirken, tarih bilgileri görünmemektedir. 257037
 
Takvim sayfasında [B5:F5] aralığı hafta içi olarak tanımlamışsınız.

9.03.2025 tarihi hafta sonu olduğu için sonuç gelmez.
 
teşekkür ederim Ziynetin bey, tamamen benim hatam :)
 
Geri
Üst