Makro İle Yardım

B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Merhaba,

Ekte örnek olarak paylaştığım bir dosyada D2, D3 ve D4 bilgilerini girdikten sonra C12:E22 aralığındaki sarı renge boyalı tablonun otomatik olarak oluşturulacağı bir makro yazmak istiyorum. Bu konuda bana destek olmanızı rica ederim. Dosyayı indirmeniz için aşağıya bir link bıraktım. Yardımlarınız benim için çok önemli çok teşekkür ederim şimdiden.

Link: https://www.dosyaupload.com/2Mfgn/Örnek.xlsx
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Konu hakkında yardımlarınızı rica ediyorum...
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Verdiğiniz dosyadaki tablonuzun C13:E22 arasında olduğunu hatırlatarak,
Aşağıdaki kodu VBA penceresinde bir Modüle içine ekleyerek çalıştırabilirsiniz.
C++: 
Sub AsgariUcretTablosuYap()
    If Range("D2") <> "Bekar" And Range("D2") <> "Evli Çocuksuz" Or _
        WorksheetFunction.CountA(Range("D2:D4")) <> 3 Or _
        Not IsDate(Range("D3")) Or Not IsDate(Range("D4")) Then
        MsgBox "Hatalı & Eksik Veri Girişi"
        Exit Sub
    End If
    ReDim Liste(1 To 9, 1 To 5)
    Liste(1, 1) = DateSerial(2015, 1, 1)
    Liste(1, 2) = DateSerial(2015, 7, 1)
    Liste(2, 1) = DateSerial(2015, 7, 1)
    Liste(2, 2) = DateSerial(2016, 1, 1)
    
    For i = 3 To 9
        Liste(i, 1) = DateSerial(2013 + i, 1, 1)
        Liste(i, 2) = DateSerial(2013 + i + 1, 1, 1)
    Next i
    
    For i = 1 To 9
        For k = 1 To 3
        Liste(i, k + 2) = Range("I2").Offset(i, k)
        Next k
    Next i
    
    Range("C14:E22").ClearContents
    Range("C14:E22").Interior.Color = Range("C13").Interior.Color
    Range("C14:E22").Font.Bold = False
    
    For i = 1 To 8
        If Range("D3") >= Liste(i, 1) And Range("D3") < Liste(i + 1, 1) Then Exit For
    Next i
    ilk = i
    For i = 1 To 8
        If Range("D4") < Liste(i, 2) Then Exit For
    Next i
    son = i
    ReDim Tablo(1 To son - ilk + 1, 1 To 3)
    For k = ilk To son
        Say = Say + 1
        If Say = 1 Then
            Tablo(Say, 1) = Range("D3")
        Else
            Tablo(Say, 1) = Liste(k, 1)
        End If
        If k = son Then
            Tablo(Say, 2) = Range("D4")
        Else
            Tablo(Say, 2) = Liste(k, 2)
        End If
    Next k
    If Range("D2") = "Bekar" Then
        agi = 4
    Else
        agi = 5
    End If
    For k = 1 To UBound(Tablo)
        Tablo(k, 3) = Liste(ilk + k - 1, agi)
    Next k
    Range("C14").Resize(Say, 3) = Tablo
    Range("C14").Font.Bold = True
    Range("C14").Offset(Say - 1, 1).Font.Bold = True
End Sub
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Çok teşekkür ederim desteğiniz için. Uygulamayı kendim de anlamak için bir örnek üzerinden ilerlemek istemiştim. Eğer yapmak istediğim şeyde takılır isem tekrar desteğinizi rica edebilirim. Tekrar teşekkürler.
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Tekrar merhaba Ömer Bey,

Yapmak istediğim şeyi aslında tam olarak aktaramamışım sanırım. Aşağıdaki örnekte (link ile dosyayı yükledim) ne yapmak istediğimi açıkça ifade etmeye çalıştım. Eğer destek olabilirseniz çok mutlu olurum.


Link: https://www.dosyaupload.com/1qkxe/Örnek2.xlsx

Saygılarımla,



ÖmerFaruk' Alıntı:
Verdiğiniz dosyadaki tablonuzun C13:E22 arasında olduğunu hatırlatarak,
Aşağıdaki kodu VBA penceresinde bir Modüle içine ekleyerek çalıştırabilirsiniz.
C++: 
Sub AsgariUcretTablosuYap()
    If Range("D2") <> "Bekar" And Range("D2") <> "Evli Çocuksuz" Or _
        WorksheetFunction.CountA(Range("D2:D4")) <> 3 Or _
        Not IsDate(Range("D3")) Or Not IsDate(Range("D4")) Then
        MsgBox "Hatalı & Eksik Veri Girişi"
        Exit Sub
    End If
    ReDim Liste(1 To 9, 1 To 5)
    Liste(1, 1) = DateSerial(2015, 1, 1)
    Liste(1, 2) = DateSerial(2015, 7, 1)
    Liste(2, 1) = DateSerial(2015, 7, 1)
    Liste(2, 2) = DateSerial(2016, 1, 1)
   
    For i = 3 To 9
        Liste(i, 1) = DateSerial(2013 + i, 1, 1)
        Liste(i, 2) = DateSerial(2013 + i + 1, 1, 1)
    Next i
   
    For i = 1 To 9
        For k = 1 To 3
        Liste(i, k + 2) = Range("I2").Offset(i, k)
        Next k
    Next i
   
    Range("C14:E22").ClearContents
    Range("C14:E22").Interior.Color = Range("C13").Interior.Color
    Range("C14:E22").Font.Bold = False
   
    For i = 1 To 8
        If Range("D3") >= Liste(i, 1) And Range("D3") < Liste(i + 1, 1) Then Exit For
    Next i
    ilk = i
    For i = 1 To 8
        If Range("D4") < Liste(i, 2) Then Exit For
    Next i
    son = i
    ReDim Tablo(1 To son - ilk + 1, 1 To 3)
    For k = ilk To son
        Say = Say + 1
        If Say = 1 Then
            Tablo(Say, 1) = Range("D3")
        Else
            Tablo(Say, 1) = Liste(k, 1)
        End If
        If k = son Then
            Tablo(Say, 2) = Range("D4")
        Else
            Tablo(Say, 2) = Liste(k, 2)
        End If
    Next k
    If Range("D2") = "Bekar" Then
        agi = 4
    Else
        agi = 5
    End If
    For k = 1 To UBound(Tablo)
        Tablo(k, 3) = Liste(ilk + k - 1, agi)
    Next k
    Range("C14").Resize(Say, 3) = Tablo
    Range("C14").Font.Bold = True
    Range("C14").Offset(Say - 1, 1).Font.Bold = True
End Sub
Genişletmek için tıkla ...
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
İlk gönderdiğiniz dosyaylar arasında ne fark var ben göremedim. Açıklar mısınız?
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Ömer Bey ek olarak, eğer makroyu paylaşma şansınız olur ise kodların sağ tarafına ne yapıldığının açıklamasını eklemeniz mümkün mü acaba?

Saygılarımla,
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
Ömer Bey çok teşekkür ederim. Eğer vakit bulursanız satırların ne işe yaradığını yazabilirseniz çok mutlu olurum. Tekrar emeğinize sağlık.
 
H

Hadegi

Katılım
22 Ocak 2022
Mesajlar
3
Excel Vers. ve Dili
Ileri Excel Türkçe
İyi aksamlar. Faktoriyel hesaplama yapmaya bilmiyorum. Derse giremedim icin de kaçırdım. Acaba yardım edebilirmisiniz?!
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
ÖmerFaruk' Alıntı:
Dosyada ufak birkaç ilave ve düzeltme yaptım. Kodlara açıklama yazdım.
Dosyanız linkte.
https://dosya.co/byk1ufy41p2r/btasci66_cevap.xlsm.html
Genişletmek için tıkla ...
Ömer Bey tekrar merhaba,

Dosyada bazı işlemler yaparken sizin yine yardımınıza ihtiyacım oldu. Dosyada G28 hücresinde notlar kısımlı yerde iki tane açıklamada bulunmaya çalışmıştım. Sizden dosyayı aldığımdan beri uğraşıyorum ama bir türlü beceremedim. Bu dosyada eğer kişinin olay tarihindeki yaşı (E9 hücresindeki yaş) eğer 18'den küçük ise 18 yaşına kadar dönem kırılımı yapmak ve o tarihe kadar da sadece NET ücretin dikkate alınmasını (AGİ ile toplanmamasını) istiyorum ama beceremedim. Ek olarak bir de A29 ve A30 hücrelerinde yer alan bilgileri de oluşturmaya çalıştım. Makro'dan bir türlü beceremedim. Defalarca deneme yaptım ama nasıl ilerleyeceğimi bilemedim. Konu hakkında yardımınızı istesem çok abartmış olur muyum acaba?

Saygılarımla,


Link: https://dosya.co/k3s64r6hk3ey/Örnek3.xlsm.html
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Bir soruyla başladınız. Soruyu yolda değiştirdiniz. Şimdi bir kez daha değiştiriyorsunuz.
Kusura bakmayın. Benden bu kadar.
 
B

btasci66

Katılım
11 Kasım 2019
Mesajlar
26
Excel Vers. ve Dili
2016 İngilizce
ÖmerFaruk' Alıntı:
Bir soruyla başladınız. Soruyu yolda değiştirdiniz. Şimdi bir kez daha değiştiriyorsunuz.
Kusura bakmayın. Benden bu kadar.
Genişletmek için tıkla ...
Merhaba Ömer Bey,

Sorumun temelini ilk başta paylaşmıştım ve onun üzerinden kendim ilerleyebilirim diye düşünmüştüm. Amacım yaptığınız şeyi öğrenmek ve üstüne koyabilmek idi. Biliyorum bir kaç kez sizi yordum bu süreçte ancak gerçekten kötü bir niyetim yoktu. Yine de desteğiniz için teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst