Makro İle Şartlı Veri Yazma

[cdemir59]

Merhaba Arkadaşlar,

"C6000“ hücresinden başlayıp yukarı doğru giderek her defasında "c” sütununda son dolu hücreyi bularak aynı satır numarasına sahip "a" hücresinden geriye doğru gidip ilk dolu" a" hücresini bulsun, bu "a" hücresindeki aynı satır numarasındaki “d” hücresindeki tarihi, her defasında “c” sütununda bulmuş olduğu son dolu hücrenin karşısındaki "d" hücresine ekteki dosyadaki şartları göz önüne alarak yazsın. Boş olan "c" sütunundaki veriler için hiçbir işlem yapmasın. Aşağıdaki linkte örnek dosyayı gönderiyorum. Bu konu ile alakalı yardımlarınızı rica ediyorum.

http://speedy.sh/d3rfw/ornek-dosya.xlsx

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u dener misiniz?

Sub BARAN()
a = [C6001].End(xlUp).Row + 1
For a = [C6001].End(xlUp).Row To 2 Step -1
    b = Range("A" & a).End(xlUp).Row
    Cells(a - 1, 4) = Cells(b, 4)
Next
End Sub

 

[cdemir59]

Ömer Bey,

Öncelikle cevabınız için teşekkürler. Yazmış olduğunuz kodları denedim, kodlar; "d" sütununda her hücrede kontrol yaparak daha önce yazılmış son tarihi alarak boş hücreye yapıştırıyor. Fakat örneğin; "c5" hücresinde "X" yazdığı için "d" sütununda daha önce yazılmış son tarihi alarak tarihi 2 arttırıp "d5" hücresine yazmıyor. Dolayısıyla dosyada sarı ile işaretlediğim şartları sağlamıyor. Bu konu ile alakalı bir çözüm mümkün müdür?

 

[Ömer BARAN]

Tekrar merhaba Sayın cdemir59.
Örnek belgenizi indiremedim, kendi hazırladığım hayali belgede denedim.
Örnek belgenizi buraya veya buraya yüklerseniz bakayım.
Örnek belgenizde, makronun yazması gereken değerleri G gibi farklı bir sütuna elle yazarsanız, makronun yazdığı değerleri kontrol etmiş olurum. Elle yazdığınız değerlerin sağına H sütununa ise o değeri nasıl tespit ettiğinizi kısaca yazarsanız bakayım.

 

[Korhan Ayhan]

Deneyin.

Sub Kosullu_Veri_Yaz()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Son = Cells(Rows.Count, "C").End(3).Row
    
    For X = Son To 4 Step -1
        Tarih = Cells(X, "B").End(3).Offset(0, 2)
        Satir = Cells(X, "B").End(3).Row + 1
        For Y = Satir To X
            Select Case Cells(Y, "C")
                Case "X"
                    Cells(Y, "D") = Tarih + 2
                Case "Y"
                    Cells(Y, "D") = Tarih + 3
                Case "Z"
                    Cells(Y, "D") = Tarih + 5
                Case "W"
                    Cells(Y, "D") = Tarih + 7
                Case "G"
                    Cells(Y, "D") = Tarih + 9
                Case "F"
                    Cells(Y, "D") = Tarih + 13
                Case "K"
                    Cells(Y, "D") = Tarih + 17
                Case "L"
                    Cells(Y, "D") = Tarih + 20
            End Select
        Next
        X = Satir - 1
    Next
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cdemir59]

Teşekkürler arkadaşlar. Tam istediğim gibi oldu. Belki başka arkadaşların da işine yarar diye dosyayı aşağıdaki linke yükledim.
http://s3.dosya.tc/server5/7k1a4s/dosya.rar.html