Yatay ve düşey tarih aralığında değer girmek

[Golden-M]

Arkadaşlar Merhaba

Ekteki sayfada belirttiğim tarih aralığında değerleri yazmak istiyorum.

 

[muygun]

Merhaba;
Makro ile çözümü deneyin.
İyi çalışmalar.

 

[Golden-M]

Merhaba;
Makro ile çözümü deneyin.
İyi çalışmalar.

Çok teşekkür ederim. işte makroyu asıl dosyama alıp ekleyemedim.
makro olayını nedense bir türlü beceremedim.

 

[Ömer BARAN]

Merhaba.

Sayın muygun'un çözümünü incelemedim. Mutlaka sorunsuz çözüm önermiştir.

Ben de formül ile çözüm önerisinde bulunmak istedim.
(İşlemde D/A yerine D/(C-B+1) sonucunun hücrelere yazılacağını varsaydım,
çünkü gün farkları ile A sütunundaki değerler arasında çelişkiler mevcut)

-- Koşula uymayan hücrelere 0 yazılmasında sorun yoksa birinci formülü,
-- Koşula uymayan hücreler BOŞ kaysın istiyorsanız ikinci formülü

E5 hücresine uygulayın ve bu hücreyi sağa ve aşağı doğru kopyalayın.

NOT: Üçüncü formülü, E5:AM28 arası seçili durumda iken koşullu biçimlendirme->formül kullan seçeneğinde kullanabilirsiniz.
.

=(($B5<=E$4)*($C5>=E$4))*($D5/($C5-$B5+1))
=[COLOR="Red"]EĞER[/COLOR](($B5<=E$4)*($C5>=E$4)=1;$D5/($C5-$B5+1);"")

=($B5<=E$4)*($C5>=E$4)

 

[muygun]

Çok teşekkür ederim. işte makroyu asıl dosyama alıp ekleyemedim.
makro olayını nedense bir türlü beceremedim.

Sayfanın kod bölümüne;

Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Sayfa1")

Sheets("Sayfa1").Range("e5:ıv65536").ClearContents '65536 satır sayısını versiyonunuza göre değiştirin.
For i = 5 To s1.Range("A65536").End(xlUp).Row '65536 satır sayısını versiyonunuza göre değiştirin.
For k = 5 To 256 '256 sütun sayısını versiyonunuza göre değiştirin.

If s1.Cells(i, "a") >= 1 Then
If s1.Cells(4, k) <> "" And s1.Cells(4, k).Value >= s1.Cells(i, "b").Value And s1.Cells(4, k).Value <= s1.Cells(i, "c").Value Then
s1.Cells(i, k) = s1.Cells(i, "d") / s1.Cells(i, "a")
End If
End If

If s1.Cells(i, "a") = 0 Then
If s1.Cells(4, k) <> "" And s1.Cells(4, k).Value = s1.Cells(i, "b").Value Then
s1.Cells(i, k) = s1.Cells(i, "d")
End If
End If

Next k
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını yerleştirin.
(bunun için sayfada iken ALT+F11 tuşlarına birlikte basarak geçiş yapabilirsiniz)

Yada Ömer Bey'in çözüm önerisini uygulayın.
(örneğinizde 2018 tarihini görünce 500 den fazla sütun ve belirsiz satır miktarı formülle çözümde dosyanın ağırlaşabileceği düşüncesiyle makroyu tercih ettim.)

 

[Golden-M]

Arkadaşlar her ikinize de çok teşekkür ederim. Emeklerinize sağlık. Baran Beyin förmülü ile çözdüm.