Değere göre farklı sonuç çıkarma

[saslan33]

Arkadaşlar merhaba ekteki excel sayfasında bir makro yapmak istiyorum fakat konu biraz karaşık olduğundan yapamadım. Yardımcı olursanız sevinirim.

 

[fedeal]

formül isterseniz b4 hücresi için;

=EĞER((A$1-A4)>(A$1* 0,05);"-1";"+1")

makrolu çözüm isterseniz;

Sub n()
yzd = CDbl(Cells(1, 1).Value) * 0.05
For i = 4 To 186
If CDbl(Cells(1, 1).Value) - CDbl(Cells(i, 1).Value) > yzd Then
Cells(i, 2).Value = "-1"
Else
Cells(i, 2).Value = "+1"
End If
Next
End Sub

iyi çalışmalar.

 

[saslan33]

sıfır konusunu formülde göremedim
-%5 ile +%5 arasındaki değere 0 yazıyormu

 

[fedeal]

pardon anlamamışım b4 hücresi için;

=EĞER(A4<(A1-(A$1*0,05));"-1";EĞER(A4>(A1+(A$1*0,05));"+1";"0"))

denermisiniz.

 

[saslan33]

Makro

Sayın fedeal birinci problemimi yardımınızla çözdüm çok teşekkür ederim. Bir problemim daha var yardımcı olursanız sevinirim çalışma kitabını ekliyorum.
İyi çalışmalar

 

[fedeal]

sayfa1 formül sayfa2 makrolu çözüm,

 

[saslan33]

Sayın fedeal çok güzel oluş teşekkür ederm. Mu makroyu benim size gönderdiğim bir sutun için yapmıştık bunu yanyana 2500 sutun için yapabilirmiyiz. Her bir sutun bit tarih içeriyor o tarihin üstünde sabit bir değer var ve tarin altıda da 150-300 arasında değer var. Değerler 1. sayfada sonuçları 2. sayfada tarih-DL Değeri-DU Değeri olarak. Bununla ilgili bir çalışma syfası ekliyorum. Tekrar yardımlarınızan dolayı teşekkür ederim.

 

[saslan33]

Sayın fedeal çok güzel oluş teşekkür ederm. Mu makroyu benim size gönderdiğim bir sutun için yapmıştık bunu yanyana 2500 sutun için yapabilirmiyiz. Her bir sutun bit tarih içeriyor o tarihin üstünde sabit bir değer var ve tarin altıda da 150-300 arasında değer var. Değerler 1. sayfada sonuçları 2. sayfada tarih-DL Değeri-DU Değeri olarak. Bununla ilgili bir çalışma syfası ekliyorum. Tekrar yardımlarınızan dolayı teşekkür ederim.

 

[fedeal]

Mu makroyu benim size gönderdiğim bir sutun için yapmıştık bunu yanyana 2500 sutun için yapabilirmiyiz.

1 sayfada 256 sütun var

 

[saslan33]

Sayın fedeal teşekkürler. Yanlız ben 2007 office kullanıyorum Excel 2007’de 16.384 adet sutun var ama. Ben onun için 1.sayfadaki değerlerin sonuçlarını 2.sayfada istemiştim. Sizin verdiğiniz makroyu oraya uygulayamadım. Yardımcı olursanız sevinirim.

 

[fedeal]

kullandıgınız versiyon 2003 olarak görünüyor. Bir şeyler yaptım yanlız uyarıyorum döngü kullanılarak yapılan bu işlem 2500 satırı hesaplar ancak bir çay molası vermeniz gerekebilir. find yada başka metotla olabilir diye düşünüyorum ama beni şuan aşacak gibi neyse deneyin problem olursa uzmanlarımız destek verir diye düşünüyorum.

Sub fd()
Dim satır, sütun, i As Long
Dim sf, sf1 As Worksheet

satır = 1
Set sf = Sheets("sayfa1")
Set sf1 = Sheets("sayfa2")

For sütun = 1 To [COLOR="Red"]3[/COLOR]
For i = 3 To sf.Cells(65536, sütun).End(xlUp).Row
If CDbl(sf.Cells(1, sütun).Value) <= CDbl(sf.Cells(i, sütun).Value) Then
If i < 11 Then
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "1"
sf1.Cells(satır, 3).Value = "0"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
If i > WorksheetFunction.CountA(Range("a:a")) - 11 Then
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "0"
sf1.Cells(satır, 3).Value = "1"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "0"
sf1.Cells(satır, 3).Value = "0"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
Next i
atla:
Next sütun
End Sub

not : sütun sayısını kırmızı işaretledim değiştirererk ayarlayın.

 

[saslan33]

Teşekkürler bende deneyeceğim.

 

[saslan33]

Sayın fedeal çok teşekkür ederim tam isteğim budur. Fakat formülde ortada olursa (yani ilk on ve son on harici olursa) DL=0, DU=0 vermiyor Galiba onun kodunda bir yanlışlık. Çözemedim ilkinde aynı sayfada yaptığınızda çalışıyordu

 

[fedeal]

Sayın fedeal çok teşekkür ederim tam isteğim budur. Fakat formülde ortada olursa (yani ilk on ve son on harici olursa) DL=0, DU=0 vermiyor Galiba onun kodunda bir yanlışlık. Çözemedim ilkinde aynı sayfada yaptığınızda çalışıyordu

ufacık bir dikkatsizlik hata veriyor.alttaki kodları düzeltim deneyin umarım olmuştur.

Sub fd()
Dim satır, sütun, i As Long
Dim sf, sf1 As Worksheet

satır = 1
Set sf = Sheets("sayfa1")
Set sf1 = Sheets("sayfa2")

For sütun = 1 To 3
sf.Select
Cells(1, sütun).Select
For i = 3 To sf.Cells(65536, sütun).End(xlUp).Row
If CDbl(sf.Cells(1, sütun).Value) <= CDbl(sf.Cells(i, sütun).Value) Then
If i < 11 Then
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "1"
sf1.Cells(satır, 3).Value = "0"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
[COLOR="Red"]If i > WorksheetFunction.CountA(Range(Split(ActiveCell.Address, "$")(1) & ":" & Split(ActiveCell.Address, "$")(1))) - 11 Then[/COLOR]
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "0"
sf1.Cells(satır, 3).Value = "1"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
satır = satır + 1
sf1.Cells(satır, 1).Value = sf.Cells(2, sütun).Value
sf1.Cells(satır, 2).Value = "0"
sf1.Cells(satır, 3).Value = "0"
sf1.Cells(satır, 4).Value = sütun
GoTo atla
End If
Next i
atla:
Next sütun
sf1.Select
End Sub

değişen satırı kırmızı yaptım.

 

[saslan33]

Çok teşekkür ederim çalışma oldu