• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

formül hedef hücreleri değiştirme

umitumit

Altın Üye
Katılım
5 Eylül 2006
Mesajlar
364
Excel Vers. ve Dili
Excel 2016
Türkçe
arkadaşlar herkese kolay gelsin,

Birçok sayfadan oluşan bir raporum var.
Bu raporun bir sayfasında özet şeklinde bir tablo oluşturup diğer sayfalardan çeşitli değerler getiriyorum.
Yaklaşık 50 hücrem bu şekilde diğer sayfalardan veri getiriyor.

Sorum şu;

bu formüllerin başvuru hücrelerini komple 2 aşağı almak istiyorum.

Örnek;

a1 hücresinde =Sayfa1!d2
b1 hücresinde =Sayfa2!e5
...


Yeni formüllerimde hedef hücreler d4 (d2+2) ve e7 (e5+2) olmalı.

Her hücrenin altına 2 satır boşluk açıp, o hücreyi aşağı sürüklersem istediğim oluyor ama çok uzun ve zahmetli bir iş.

Yardım edecek arkadaşlara şimdiden teşekkürler.
 
Merhaba,

Bir çok yolla yapılabilir, yalnız yazdığınız formülün bir standartı varsa formülü tüm tablo için değiştirmek yerine, A1 hücresine yazıp alt satırlara kopyalarak istenen sonuc elde edilebiliriz.

Konuyu özetleyen küçük bir tablo hazırlayıp dosya içerisinde formüldeki mantığı açıklarsanız daha pratik bir yol bulma şansımız olur.

.
 
Belli bir sistemetik yok.
Tek sistematik formulün başvurduğu hücrenin mesela 2 aşağıya kayacak olması.

1.sayfadan a2 hücresinden gelen veri a4 ten gelecek.
2.sayfadan b5 hücresinden gelen veri b7 den gelecek.
3.sayfadan f7 hücresinden gelen veri f9 dan gelecek.

Tüm başvurular 2 aşağı kayacak. (2 aşağı durumu sabit değil. tüm formüller için aynı değer olmak üzere aşağı yada yukarı kaymalar olabilmeli. 2 aşağı, 3 yukarı...)
 
formül hedef hücreleri değiştirme

Kodları module kopyalayıp dosyanızı kaydedin ve kapatıp açın.

Bu işlemden sonra kitabı açtığınız zaman, fare sağ kilik menüsüne "Yeni--->Formul Degis" adında yeni bir seçenek eklendiğini görebilirsiniz.

Herhangi bir alanı seçip sağ klik yaptıktan sonra bu seçeneği işaretlediğiniz de ekrana sorgu kutusu gelecektir, bu kutuya + yada - değer girip tamam ile devam ederseniz seçili alandaki formüllerin satır sayıları belirlediğiniz değer kadar azalacak yada artacaktır.

Kod:
Sub Auto_Open()
     FareMenu
End Sub
''''''''''''''''''''''''''''''
Sub FareMenu()
 
    Dim cb As CommandBar, MenuObject
 
    Set cb = Application.CommandBars("Cell")
    Set MenuObject = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
 
    With MenuObject
        .OnAction = "Degistir"
        .FaceId = 9
        .Caption = "Yeni--->Formul Degis"
    End With
 
    Set cb = Nothing: Set MenuObject = Nothing
 
End Sub
''''''''''''''''''''''''''''''
Sub Degistir()
 
    Dim hucre As Range, sor As Variant, d0 As String, d1 As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
 
    sor = Application.InputBox("Artış Yada Azalış Girin", "+ , - Değişim")
 
    If sor = "" Then Exit Sub
 
    For Each hucre In Selection.SpecialCells(xlCellTypeFormulas, 23)
        With hucre
            d0 = Split(formul(Range(.Address)), "!")(0)
            d1 = Split(formul(Range(.Address)), "!")(1)
            .Value = d0 & "!" & sayibul(d1, 0) & sayibul(d1, 1) + Val(sor)
        End With
    Next hucre
 
    Application.ScreenUpdating = True
 
End Sub
''''''''''''''''''''''''''''''
Function formul(InputCell As Range) As String
    formul = InputCell.FormulaLocal
End Function
''''''''''''''''''''''''''''''
Function sayibul(hucre As String, sonuc As Boolean) As String
 
    With CreateObject("VbScript.Regexp")
        .Pattern = IIf(sonuc, "[^\d]", "\d")
            .Global = True
        sayibul = .Replace(hucre, "")
    End With
 
End Function
''''''''''''''''''''''''''''''
Sub Auto_Close()
    Application.CommandBars("Cell").Reset
End Sub

.
 
Geri
Üst