formül konsolide etmek

[cerit]

Merhaba,
dosyayı yeniledim.
Formülleri nasıl kısaltabiliriz.

İndir aidat docx

Dosyayı indir aidat docx

dosya.co

 

[cerit]

merhaba,
yapay zeka ile bu şekilde kısaltma geldi ama çalıştıramadım.
Sub Setup_A_DAT_Formulas_Optimized()
' AİDAT sayfası için optimize edilmiş formül kurulumu
' Bu kod, 800+ satırlık işlemi döngü ve R1C1 formatı ile saniyeler içinde tamamlar.

Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

' Performans ayarlarını kapat (Hızlandırmak için)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

On Error GoTo ErrorHandler
Set ws = Worksheets("AİDAT")

' Başlık ve Sabit Formüller
ws.Range("B1").Formula = "=AYARLAR!N8 & "" YILI"""
ws.Range("E1").Formula = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""),1)+1,SEARCH(""]"",CELL(""filename""),1)-SEARCH(""["",CELL(""filename""))-5)"
ws.Range("U2").Formula = "=TEXT(TODAY(),""AAAA"")"
ws.Range("E3").Formula = "=AYARLAR!N8-1 & "" DEVİR BORÇ"""

' Veri Satırları İçin Döngü (Örn: 4. satırdan 115. satıra kadar)
' Not: Satır sayısını ihtiyacınıza göre 115 yerine daha büyük bir sayı yapabilirsiniz.
For i = 4 To sonsatır
' C Sütunu: Birleştirme
ws.Cells(i, "C").FormulaR1C1 = "=GİRİŞ!RC[-2]&GİRİŞ!RC[-1]&GİRİŞ!RC[3]"

' D Sütunu: İsim Maskeleme (Karmaşık formülünüzü R1C1 formatına çevirdik)
' Bu formül GİRİŞ sayfasındaki G sütununa (RC[3]) bakar
ws.Cells(i, "D").FormulaR1C1 = _
"=IF(GİRİŞ!RC[3]="""","""",IF(LEN(GİRİŞ!RC[3])-LEN(SUBSTITUTE(GİRİŞ!RC[3],"" "",""""))=0,MID(GİRİŞ!RC[3],1,2)&REPT(""*"",LEN(GİRİŞ!RC[3])-2)," & _
"IF(LEN(GİRİŞ!RC[3])-LEN(SUBSTITUTE(GİRİŞ!RC[3],"" "",""""))=1,MID(GİRİŞ!RC[3],1,2)&REPT(""*"",LEN(MID(GİRİŞ!RC[3],1,FIND("" "",GİRİŞ!RC[3])-1))-2)&"" ""&MID(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1,LEN(GİRİŞ!RC[3])-FIND("" "",GİRİŞ!RC[3])),1,2)&REPT(""*"",LEN(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1,LEN(GİRİŞ!RC[3])-FIND("" "",GİRİŞ!RC[3])))-2)," & _
"IF(LEN(GİRİŞ!RC[3])-LEN(SUBSTITUTE(GİRİŞ!RC[3],"" "",""""))=2,MID(GİRİŞ!RC[3],1,2)&REPT(""*"",LEN(MID(GİRİŞ!RC[3],1,FIND("" "",GİRİŞ!RC[3])-1))-2)&"" ""&MID(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1,FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)-FIND("" "",GİRİŞ!RC[3])-1),1,2)&REPT(""*"",LEN(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1,FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)-FIND("" "",GİRİŞ!RC[3])-1))-2)&"" ""&MID(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)+1,LEN(GİRİŞ!RC[3])-FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)),1,2)&REPT(""*"",LEN(MID(GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)+1,LEN(GİRİŞ!RC[3])-FIND("" "",GİRİŞ!RC[3],FIND("" "",GİRİŞ!RC[3])+1)))-2),))))"

' E Sütunu: VLOOKUP GİRİŞ
ws.Cells(i, "E").FormulaR1C1 = "=IF(RC[-1]="""","""",IFERROR(VLOOKUP(RC[-1],GİRİŞ!R3C7:R115C9,3,0),"" ""))"

' F-Q Sütunları: Aylar (VLOOKUP)
' Ocak(F) - Aralık(Q) arası 12 ay için döngü içi döngü veya toplu atama
Dim months As Variant
months = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")

Dim m As Integer
For m = 0 To 11
ws.Cells(i, 6 + m).FormulaR1C1 = "=IF(RC4="""","""",IFERROR(VLOOKUP(RC4," & months(m) & "!R6C3:R115C4,2,0),"" ""))"
Next m

' R Sütunu: Toplam
ws.Cells(i, "R").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"

' V-W Sütunları: Hesaplamalar
ws.Cells(i, "V").FormulaR1C1 = "=SUM(GİRİŞ!RC[13]:RC[24],RC[-17])-RC[-4]"
ws.Cells(i, "W").FormulaR1C1 = "=RC[-1]"

' X Sütunu: Demirbaş
ws.Cells(i, "X").FormulaR1C1 = "=DEMİRBAŞ!RC[-2]"

' Y Sütunu: Genel Toplam
ws.Cells(i, "Y").FormulaR1C1 = "=RC[-3]+RC[-1]"
Next i

CleanUp:
' Ayarları geri yükle
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "İşlem başarıyla tamamlandı!", vbInformation
Exit Sub

ErrorHandler:
MsgBox "Bir hata oluştu: " & Err.Description, vbCritical
Resume CleanUp
End Sub

metin rengi kırmızı olan formüller yerine "isimmaskeleme" kullanılmaktadır.
saygılarımla

 

[Muzaffer Ali]

Merhaba.
Kodları düzenlemek yerine tam olarak ne yapmak istediğinizi örnek bir dosya hazırlayarak üzerinde gösterip sorarsanız daha hızlı ve doğru yanıt alırsınız.
Dosyanızı dosya.co gibi bir paylaşım sitesinde paylaşabilirsiniz.

 

[cerit]

Hocam merhaba,
Dosyayı paylaşamıyorum,kodları kısa ve daha hızlı yapmak istiyorum.
Saygılar.