• DİKKAT

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

SIFIRLAMA

Bu şekilde dener misiniz.
Kod: 
Private Sub Worksheet_Calculate()

   Dim a, b, alan, s As Long, son As Long, i As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
   
    a = Range("a2").Value
    b = Range("b2").Value
   
    son = Cells(Rows.Count, "A").End(xlUp).Row
    alan = Range("A8:T" & son).Value
   
    ReDim dizi(1 To son, 1 To 20)
   
    For i = LBound(alan) To UBound(alan)
        s = s + 1
        If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = "0" Then
            dizi(s, 1) = alan(i, 1)
        Else
            dizi(s, 1) = alan(i, 2)
        End If
    Next i
   
    Range("B8").Resize(s, 1) = dizi
   
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
End Sub
 
ömer abi şimdi yükledim oldu gibi sanki ama şu an piyasa kapalı olduğu için 4-5 ürün var onların fiyatlarını sıfırlıyor veriler çoğalınca kapanır mı bilmiyorum abi
 
Eski kodları şuan yükleyince yavaşlama-kapanma vs. oluyorsa yeni kodlar daha iyi demek ki :)
 
IsyNetPosWithRef($E$2;E8;E8;"NetPlusLeavesQty")
buna benzer formuller var abi sizin excelde çalışmaz ondan dosyayı tam atamıyordum anca arkadaşlar bilgisayarıma bağlanıp yapmaya çalışıyorlar dı belli bir yerde kaldık olmadı ama sanırım bu olacak gibi pazartesi anlık veriler çoğalınca sıkışma olacak mı bilemiyorum ama bu kodla şu an excel kapanmadı ve 3 tane veri geliyor sistem çalışıyor
 
Pazartesi deneyip dönüş yaparsınız. Yeni kodlar veri yazma işini döngü içinde yapmadan sonucu tek seferde alana yazdığı için daha hızlı olacaktır diye düşünüyorum.
 
İnşallah abi problem olmaz şu an 4 veri geliyor ve sıfırlıyor inşallah diğer formuller ve özel fonksiyonlar sistem açılınca sıkıntı yapmaz
 
Ömer abi T sütunu 0 olma şartı vardı onu 0 ve 0 dan küçük ayarlayabilir miyiz -0 oldu sistemde ama çalışmadı
 
alan(i, 20) = "0"

Yerine aşağıdaki gibi kullanın.

alan(i, 20) <= 0
 
bu alan abi -0 yazdığı için sistem biraz karışıyor ama AF sütunu iki şart var sadece ya 0,00 yada 0 dan büyük orada -0 yazmıyor kesinlikle o şartı AF sütuna göre ayarlayabilirmiyiz
 
Ayarlarız tabi de, <=0 yazdığınız da olmadı mı. 0 dan küçük ve sıfır olan değerler için demek.
 
-0 yapmadı sanırım 300 tane hisse oldugundan mı göremedim veya yine makro sayfası açıktı ondan mı olmadı
 
Bu şekilde deneyin.
Kod: 
Private Sub Worksheet_Calculate()

   Dim a, b, alan, s As Long, son As Long, i As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
  
    a = Range("a2").Value
    b = Range("b2").Value
  
    son = Cells(Rows.Count, "A").End(xlUp).Row
    alan = Range("A8:AF" & son).Value
  
    ReDim dizi(1 To son, 1 To 32)
  
    For i = LBound(alan) To UBound(alan)
        s = s + 1
        If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 32) = 0 Then
            dizi(s, 1) = alan(i, 1)
        Else
            dizi(s, 1) = alan(i, 2)
        End If
    Next i
  
    Range("B8").Resize(s, 1) = dizi
  
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub
 
ömer abi A2 ve B2 değer veriyorduk oradaki değerlere göre sıfırlıyordu bu işlem her satırın değeri ayrı olsa o değerleri ben hissenin satırına yazsam örnek (Y8:-0,06 ---- Z8: 0,06) her satırın değerine ulaşınca kopyala yapıştır yapabilir mi bazı hisseler ucuz olduğu için -0,06 veya 0,06 ulaşamıyorlar düşük fiyatlı olanları örneğin -0,03 ve 0,03 yapmak istiyorum çok yüksek olan hisseleri ise biraz daha arttırmak istiyorum -0,1 ve 0,1 gibi bazılarında şartlar çok kolay sağlanıyor bazılarında ise şartlar sağlanmıyor abi her satırın değerine göre sıfırlarsa süper olur
 
AF = 0 şartı artık yok sanırım.

Deneyiniz.
Kod: 
Private Sub Worksheet_Calculate()

   Dim alan, s As Long, son As Long, i As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
  
    son = Cells(Rows.Count, "A").End(xlUp).Row
    alan = Range("A8:AO" & son).Value
  
    ReDim dizi(1 To son, 1 To 41)
  
    For i = LBound(alan) To UBound(alan)
        s = s + 1
        If alan(i, 3) < alan(i, 40) Or alan(i, 3) > alan(i, 41) Then
            dizi(s, 1) = alan(i, 1)
        Else
            dizi(s, 1) = alan(i, 2)
        End If
    Next i
  
    Range("B8").Resize(s, 1) = dizi
  
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst