Formüllü hücrelerin alt satırlara geçmesi

[zkssharky]

Merhaba

Bir üst satırda yer alan(D4,E4,F4) formüllerin otomatik veya makro vasıtasıyla bir alt satıra kopyalanması mümkün müdür?

Yardımlarınız için şimdiden teşekkür ederim.

http://www.dosya.tc/server6/irw8pt/Fdeneme.zip.html

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırırsanız A, B ve C sütunlarına veri girdikçe D, E ve F sütunlarında formülle yaptığınız işi makroyla yapar ve sonucunu yazar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A4:C4000")) Is Nothing Then Exit Sub
a = Target.Row
Cells(a, "D") = Cells(a, "A") & " " & Cells(a, "B")
Cells(a, "E") = WorksheetFunction.CountIf(Range("D:D"), Cells(a, "D"))
If Cells(a, "E") = 1 Then
    Cells(a, "F") = "YENİ MÜŞTERİ"
Else
    Cells(a, "F") = "KAYITLI MÜŞTERİ"
End If

End Sub

 

[YUSUF44]

KAYITLI MÜŞTERİ değil HATALI KAYIT olacakmış:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A4:C4000")) Is Nothing Then Exit Sub
a = Target.Row
Cells(a, "D") = Cells(a, "A") & " " & Cells(a, "B")
Cells(a, "E") = WorksheetFunction.CountIf(Range("D:D"), Cells(a, "D"))
If Cells(a, "E") = 1 Then
    Cells(a, "F") = "YENİ MÜŞTERİ"
Else
    Cells(a, "F") = "HATALI KAYIT"
End If

End Sub

Ben orda o formülleri görmek istiyorum diyorsanız şöyle kullanabilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A4:C4000")) Is Nothing Then Exit Sub
a = Target.Row

    Cells(a, "D").FormulaR1C1 = "=RC[-3]&"" ""&RC[-2]"
    Cells(a, "E").FormulaR1C1 = "=COUNTIF(C4,C[-1])"
    Cells(a, "F").FormulaR1C1 = "=IF(RC[-1]=1,""YENİ MÜŞTERİ"",""HATALI KAYIT"")"
End Sub

 

[zkssharky]

Hocam çok teşekkür ederim yardımların için fakat kod bölümüne kaydettiğimde hiç bir değişiklik olmadı, nerede hata yapıyor olabilirim?

KAYITLI MÜŞTERİ değil HATALI KAYIT olacakmış:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A4:C4000")) Is Nothing Then Exit Sub
a = Target.Row
Cells(a, "D") = Cells(a, "A") & " " & Cells(a, "B")
Cells(a, "E") = WorksheetFunction.CountIf(Range("D:D"), Cells(a, "D"))
If Cells(a, "E") = 1 Then
    Cells(a, "F") = "YENİ MÜŞTERİ"
Else
    Cells(a, "F") = "HATALI KAYIT"
End If

End Sub

Ben orda o formülleri görmek istiyorum diyorsanız şöyle kullanabilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A4:C4000")) Is Nothing Then Exit Sub
a = Target.Row

    Cells(a, "D").FormulaR1C1 = "=RC[-3]&"" ""&RC[-2]"
    Cells(a, "E").FormulaR1C1 = "=COUNTIF(C4,C[-1])"
    Cells(a, "F").FormulaR1C1 = "=IF(RC[-1]=1,""YENİ MÜŞTERİ"",""HATALI KAYIT"")"
End Sub

 

[YUSUF44]

A, B ya da C sütunlarına (4. satırdan itibaren) veri girmeyi denediniz mi?

 

[YUSUF44]

Ekteki dosyayı inceleyiniz:

https://drive.google.com/file/d/0B43WMUs21VpfTjNTNGNjVEs5aVk/view?usp=sharing

 

[zkssharky]

hocam mükemmel olmuş eline koluna sağlık.

Ekteki dosyayı inceleyiniz:

https://drive.google.com/file/d/0B43WMUs21VpfTjNTNGNjVEs5aVk/view?usp=sharing