şu kod'u kısaltmanın bir yolu var mı?

[excellium]

Range("a1").Select
    ActiveCell.FormulaR1C1 = "son 20 adım..."
    Range("E1").Select
    Selection.Copy
    Range("E5:E50").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E5:E50").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    
    Range("a1").Select
    ActiveCell.FormulaR1C1 = "son 19 adım..."
    Range("E1").Select
    Selection.Copy
    Range("E51:E100").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Range("F51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E51:E100").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
        Range("a1").Select
    ActiveCell.FormulaR1C1 = "son 18 adım..."
Range("E1").Select
    Selection.Copy
    Range("E101:E150").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Range("F101").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E101:E150").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
        Range("a1").Select
    ActiveCell.FormulaR1C1 = "son 17 adım..."
Range("E1").Select
    Selection.Copy
    Range("E151:E200").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Range("F151").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E151:E200").Select
    Application.CutCopyMode = False
    Selection.ClearContents
.
.
.
.

bunu kısaltmanın bir yolu varmı?
neden böyle yaptım?: e1 hücresindeki formül:

=TOPLA.ÇARPIM((($O$2:DOLAYLI(BİRLEÞTİR("o";indis)))=$A2)*(($P$2:DOLAYLI(BİRLEÞTİR("p";indis)))=$B2)*(($Q$2:DOLAYLI(BİRLEÞTİR("q";indis)))=C$1)*(($R$2:DOLAYLI(BİRLEÞTİR("r";indis)))))

4 koşullu...

1000 satırı birden hesaplamaya çalışınca çok zaman alıyor ve kilitlenebiliyor. ben de 50 şer 50 şer ayırıp 20 adıma böldüm. bu şekilde yapınca da kod yazması büyük problem. bu konuda da zaten acemiyim, bir yol gösterirseniz sevinirim.

 

[Levent Menteşoğlu]

Tam cevap için ne yapmak istediğinizi anlatırmısınız. Sorunuz için tek çözüm bir for next döngüsü içinde kodlarınızı kullanmaktır.

 

[excellium]

:yardim: e1 hücresinde bir formül var ve ben bu formülü kopyala yapıştır yoluyla 1000 adet hücreye uygulamak istiyorum. hücre hesaplandıktan sonra değerleri yan sütuna kopyalıyorum ki formüller tekrar hesaplanmasın. değerleri kopyaladıktan sonra tekrar siliyorum ve diğer 50 hücreye geçiyorum.
:kafa: kısaca ;

e1 i kopyalayıp, diğer alt hücre grubuna yapıştırıyor ve hesaplattırıyorum
sonuçları yan sütuna değer olarak yapıştırıyorum
formülleri siliyorum(işleri bitti çünkü)
sonra e1 i kopyalayıp diğer alt gruplara geçiyorum.

bu böyle 20 kez tekrar edince 1000 adet hücrenin sonuçları elime sadece olarak geçiyor.

hepsini birdn hesaplamaya kalkınca excel kafayı yiyo :cekic:

 

[excellium]

bu arada:

=TOPLA.ÇARPIM((($O$2:DOLAYLI(BİRLEÞTİR("o";indis)))=$A2)*(($P$2:DOLAYLI(BİRLEÞTİR("p";indis)))=$B2)*(($Q$2:DOLAYLI(BİRLEÞTİR("q";indis)))=C$1)*(($R$2:DOLAYLI(BİRLEÞTİR("r";indis)))))

burada verileri 20000 satırdan çekiyor, indis son satırdaki verinin satır numarası. bu 20000 değeri bazen 10000, bazen daha az oluyor. boşuna boş hücreleri aramaması için böyle yaptım, bilmem doğru mu? indis değeri 9000 olunca o2 ile o9000 arasındaki verileri tarıyor...

yardım için teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:43b14c9fb3]Sub kopyala()
Application.ScreenUpdating = False
For a = 5 To 1000
Range("E1").Copy
Cells(a, "e").PasteSpecial
Cells(a, "f") = Cells(a, "e").Value
Cells(a, "e").Clear
Next
End Sub[/vb:1:43b14c9fb3]

 

[excellium]

:mutlu:
teşekkürler...