Formülü belli aralıklarla yapıştırmak

[atakan55]

Merhabalar Mesela: herhangi bir formülü C sutununda 18 hücre aralıkla yapıştırma
=Topla(B1:B18)i C19, C37, C55, C73, C91, ..... Şeklinde yapıştırmak istiyorum.

Birde 2 yazdığımda 200, 25 yazdığımda 250 yazmasını istiyorum, Virgülsüz
Hayırlı akşamlar.

 

[hamitcan]

Örnek dosya ekleyin.

 

[Korhan Ayhan]

Merhaba,

1. Sorunuz için;

C19 hücresinde işlem sonunda formül ne olması gerekiyor.

2. Sorunuz için;

Bu biçimlendirmeyi uygulamak istediğiniz aralığı seçin.
Hücre biçimlendirme menüsünü açın.
İsteğe uyarlanmış bölümüne aşağıdaki biçimi uygulayın.

[<10]#"00";[<99]##"0";Genel

Bu uygulamadan sonra hücreye 1 yazdığınızda sadece görsel olarak 100 görünümünü alacaktır. Hücredeki değer hesaplamalarda 1 olarak baz alınacaktır.

Eğer siz 1 yazdığınızda hücredeki değerin gerçek anlamda 100 olmasını istiyorsanız sayfanızın kod bölümüne aşağıdaki kodu uygulamanız gerekecektir.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    Application.EnableEvents = False
    If Target <> "" And IsNumeric(Target) Then
        Target = CDbl(Target & WorksheetFunction.Rept("0", 3 - Len(Target)))
    End If
Son: Application.EnableEvents = True
End Sub

 

[atakan55]

Sutuna 1yazdığıda değer 100 olmalı

Merhabalar!
Örnek dosyadada göreceğiniz gibi "B" sutununa 1 yazdığımda 100, 15 yazdığımda 150 olmasını istiyorum, Mümkünmü.
Birde Korhan bey kod girmeyi örnek dosyada gösterirseniz memnun olurum. ordada göreceğiniz gibi ben makroyı otomatikleştirmek için yine burda bulduğum "Worksheet_Calculate" makrosunu çalıştırmak için

"Private Sub Worksheet_Change(ByVal Target As Range)
Run "Worksheet_Calculate"
End Sub"
bu komutu kullandım. Fakat orjinal dosya çok büyük olduğundan onda kullanamıyorum. Çünkü daha yazmaya bile başlamadan her hücreye tıkladığımda sutunlar ve satırlar hepsi birden açılıp kapanıyor.

Yaptığınız ve yapacağnız yardımlarınız için teşekkürler. Gerçi bunada şükür benim için buda bir başarı ne bilim hergün yeni birşeyler öğrenmek hoşuma gidiyor.

 

[atakan55]

Slm Korhan bey yukarıdaki kodu girmeyi sonunda başardım. bunu sadece bir sutun veya sutunlarla yani B sutunuyla nasıl sınırlayabilirim. kardaş her şey için Allah razı olsun

 

[Korhan Ayhan]

Merhaba,

İlk olarak tüm eski kodlarınızı silin. Daha sonra aşağıdaki işlemi uygulayıp deneyin.

"Kağıtlık Odun" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Calculate()
    On Error GoTo Son
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Cells.EntireRow.Hidden = False
    If WorksheetFunction.Sum(Range("F3,H3,I3,K3")) = 0 Then
       Range("F3,H3,I3,K3").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F4,H4,I4,K4")) = 0 Then
       Range("F4,H4,I4,K4").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F5,H5,I5,K5")) = 0 Then
       Range("F5,H5,I5,K5").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F6,H6,I6,K6")) = 0 Then
       Range("F6,H6,I6,K6").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F7,H7,I7,K7")) = 0 Then
       Range("F7,H7,I7,K7").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F8,H8,I8,K8")) = 0 Then
       Range("F8,H8,I8,K8").EntireRow.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("F9,H9,I9,K9")) = 0 Then
       Range("F9,H9,I9,K9").EntireRow.Hidden = True
    End If
    Cells.EntireColumn.Hidden = False
    If WorksheetFunction.Sum(Range("F3:F9,H3:H9")) = 0 Then
        Range("F3:F9,H3:H9").EntireColumn.Hidden = True
    End If
    If WorksheetFunction.Sum(Range("I3:I9,K3:K9")) = 0 Then
        Range("I3:I9,K3:K9").EntireColumn.Hidden = True
    End If
Son:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("B3:B65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target <> "" And IsNumeric(Target) Then
        Target = CDbl(Target & WorksheetFunction.Rept("0", 3 - Len(Target)))
    End If
Son: Application.EnableEvents = True
End Sub

 

[atakan55]

Sağolasın kardaş, çalıştı, Teşekkür ederim, Allah razı olsun.