makro ile formül yazdırma

[gnorar]

Makro ile A1-A10 hücrelerine =EĞER(B1="";"";B1) formülünü yazdırmak istiyorum ama olmuyor. Bunun için kullanmaya çalıştığım kod aşağıda (aslında formül çok daha uzun ve karışık, buraya basit bir formül yazdım.)

For j = 1 To 10
Sheets("Sayfa1").Range("A" & j) = "=B" & j &.........
next j

Bu formüle göre .... gelen yerlere nasıl devam etmeliyim

 

[Emir Hüseyin Çoban]

Merhaba, aşağıdaki kodları deneyiniz.

Sub copy_paste()
    Range("A1").FormulaR1C1 = "=IF(RC[1]="""","""",RC[1])"
    Range("A1").Copy
    Range("A2:a10").PasteSpecial
    Application.CutCopyMode = False
End Sub

 

[gnorar]

Merhaba, aşağıdaki kodları deneyiniz.

Sub copy_paste()
    Range("A1").FormulaR1C1 = "=IF(RC[1]="""","""",RC[1])"
    Range("A1").Copy
    Range("A2:a10").PasteSpecial
    Application.CutCopyMode = False
End Sub

mesajımda bahsettiğim gibi aslında formül çok uzun ve karışık ayrıca for next döngüsü kullanmak zorundayım. Bu nedenle bu çözüm işe yaramıyor.

 

[Korhan Ayhan]

Selamlar,

Formülünüzü eklermisiniz.

 

[gnorar]

Selamlar,

Formülünüzü eklermisiniz.

Formül aşagıdaki gibi olacak:

i=5000 : J = 1: k = 1
For l = 1 To i

Sheets("Stok").Cells(l, 2) =EĞER(VE(Gj<>0;C(j+1)<>0);TOPLAM(G$k:G$(k+1);EĞER(VE(Gj<>0;G(j+1)="");TOPLAM(G$k:G$(k+1));""))

j = j + 2
k = k + 1
Next l

 

[gnorar]

Formülü baştaki = işareti olmadan hücreye doğru olarak yazdırıyorum. Ancak formül başına = koyunca:

Run-time error '1040':
Application-defined or object-defined error

hatası veriyor. Bu hata nasıl aşılabilir?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DÖNGÜ_İLE_FORMÜL_YAZ()
    Dim X As Integer, J As Integer, K As Integer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    J = 1: K = 1
 
    For X = 1 To 5000
        Sheets("Stok").Cells(X, 2) = "=IF(AND(G" & J & "<>0,C" & J + 1 & "<>0),SUM(G$" & K & ":G$" & K + 1 & "),IF(AND(G" & J & "<>0,G" & J + 1 & "=""""),SUM(G$" & K & ":G$" & K + 1 & "),""""))"
        J = J + 2
        K = K + 1
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[gnorar]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DÖNGÜ_İLE_FORMÜL_YAZ()
    Dim X As Integer, J As Integer, K As Integer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    J = 1: K = 1
 
    For X = 1 To 5000
        Sheets("Stok").Cells(X, 2) = "=IF(AND(G" & J & "<>0,C" & J + 1 & "<>0),SUM(G$" & K & ":G$" & K + 1 & ",IF(AND(G" & J & "<>0,G" & J + 1 & "=""""),SUM(G$" & K & ":G$" & K + 1 & ")),""""))"
        J = J + 2
        K = K + 1
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Formülü yazarken 1 parantezi yazmayı atlamış olmam nedeniyle formül işlevini görmüyor. Parantez yerine konulduğunda ise yukarda bahsettiğim hatayı vermeye devam ediyor. Doğru formül aşağıdaki gibi olmalı. (Unutulan: 1. SUM'ın sonundaki, IF den önceki parantez işareti)


Sheets("Stok").Cells(X, 2) = "=IF(AND(G" & J & "<>0,C" & J + 1 & "<>0),SUM(G$" & K & ":G$" & K + 1 & "),IF(AND(G" & J & "<>0,G" & J + 1 & "=""""),SUM(G$" & K & ":G$" & K + 1 & ")),""""))"

Sonuçta hücreye yazılması gereken gormül şöyle olmalı (***** hariç). Yazdırılmayan parantez ***** arasındaki parantezdir.

=EĞER(VE(G1<>0;C2<>0);TOPLAM(G$1:G$2*****)*****;EĞER(VE(G1<>0;G2="");TOPLAM(G$1:G$2));""))

Parantez yerine konduğunda aynı hata devam ettiğinden sorunu tekrar değerlendirirseniz sevinirim.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[gnorar]

Sn. Korhan Ayhan, yardımlarınızla sorunu çözdüm. Teşekkür ederim.