• DİKKAT

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

İZ SÜREN

Merhabalar,
D1 sabit 0,05 ise ve C4 5,2 ve büyükse B4 de düşüş olacak,
B4 e yazarak dener misiniz?
=EĞER(C4>=5,2;C4-D1;5,2)
 
Bunu makro ile yapmamiz lazim ciktiginda 0.05 oranla takip edecek ama duserse anlik fiyat takip eden fiyat geri salmayacak
 
Yani C4 yukselirken B4 ( 0.05) takip edecek ama C4 dusmeye basladigin B4 hucresi geri gelmeyecek
 
Ekli dosyada form ile yapılan çalışma.

Anlık alana değer yazmanız yeterli.
 

Ekli dosyalar

C4 devamlı anlık veri geliyor D1 stop değerim var 0,05 burda C4-D1 sonucu B4 yazdırıyoruz
C4 yukarı gittikçe örnegi 5,20-5,21-5,22-5,23 D1 değer miktarı kadar B4 sonuc geliyor yani5,20-0,05=5,15(,5,21-0,05=5,16) (5,22-0,05=5,17) fiyatımız 5,17 kadar çıktı 5,22 düşmeye başlarsa 5,17 geriye düşmeyecek orda sabit kalacak ama anlık veri 5,23 oldumu tekrar B4 (5,18) Olacak ileriye gidecek ama geriye düşmeyecek
 
Merhaba

Çalışma sayfasının kod bölümüne kopyalayınız.
Kod: 
Private Sub Worksheet_Calculate()
    
    Dim a As Double, b As Double, c As Double
    
    a = [B4]
    b = [C4] - [D1]
    c = Application.Max(a, b)
    
    [B4] = c
    
End Sub
 
Private Sub Worksheet_Calculate()

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

With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With

son = Cells(Rows.Count, "A").End(xlUp).Row
alan = Range("A8:T" & son).Value
a = Range("A2").Value
b = Range("B2").Value

ReDim dizi(1 To son, 1 To 20)

For i = LBound(alan) To UBound(alan)
s = s + 1
dizi(s, 1) = alan(i, 2)
If Not IsError(alan(i, 3)) And Not IsError(alan(i, 20)) Then
If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = 0 Then
dizi(s, 1) = alan(i, 1)
End If
End If
Next i

Range("B8").Resize(s, 1) = dizi

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
bunun içine mi yükleyeceğiz ömer abi bunun için ise siz yapın abi ben hücrelerin ismini değiştiririm abi
 
Private Sub Worksheet_Calculate()

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

With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With

son = Cells(Rows.Count, "A").End(xlUp).Row
alan = Range("A8:T" & son).Value
a = Range("A2").Value
b = Range("B2").Value

ReDim dizi(1 To son, 1 To 20)

For i = LBound(alan) To UBound(alan)
s = s + 1
dizi(s, 1) = alan(i, 2)
If Not IsError(alan(i, 3)) And Not IsError(alan(i, 20)) Then
If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = 0 Then
dizi(s, 1) = alan(i, 1)
End If
End If
Next i

Range("B8").Resize(s, 1) = dizi

Private Sub Worksheet_Calculate()

Dim a As Double, b As Double, c As Double

a = [B4]
b = [C4] - [D1]
c = Application.Max(a, b)

[B4] = c

End Sub

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
Deneyiniz.
Kod: 
Private Sub Worksheet_Calculate()

Dim alan, s As Long, son As Long, i As Long, a As Double, b As Double
Dim x As Double, y As Double, z As Double
  
With Application
.ScreenUpdating = False
.Calculation = xlManual
.EnableEvents = False
End With

x = [B4]
y = [C4] - [D1]
z = Application.Max(x, y)

[B4] = z

son = Cells(Rows.Count, "A").End(xlUp).Row
alan = Range("A8:T" & son).Value
a = Range("A2").Value
b = Range("B2").Value

ReDim dizi(1 To son, 1 To 20)

For i = LBound(alan) To UBound(alan)
s = s + 1
dizi(s, 1) = alan(i, 2)
If Not IsError(alan(i, 3)) And Not IsError(alan(i, 20)) Then
If (alan(i, 3) < a Or alan(i, 3) > b) And alan(i, 20) = 0 Then
dizi(s, 1) = alan(i, 1)
End If
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