19.12.16

Excel Visual Basic Application Sevdası

excel vba

Bir dönem tutkulu bir excel sevdalısıydım. Günlerim hatta gecelerim, excel geri planında (altında) çalışan VBA. ( visual basic applicatin ) uygulamasında kod yazıp çalıştırmakla geçiyordu.

İçimdeki excel vba aşkıyla kendi işlerimi kolaylaştırmak için hazırladığım uygulamaları, içimdeki paylaşım dürtüsüyle diğer ihtiyacı olan insanlarla paylaşmak için, www.kod.gen.tr isimli alan adıyla bir forum sitesi kurdum.

Forum sayesinde güzel arkadaşlıklar ve paylaşım ortamı oluşturduk. Tam 10.000 (onbin) üyeye ulaştık. www.kod.gen.tr forum sitemizde, vefasıyla,  bilgisi, güler yüzü ve samimiyetiyle tanımaktan memnun olduğum kişilerden bir tanesi de Bülent Öztürk kardeşimdir.

Bu sektörde duayen kim isim kim derseniz, tartışmasız M. Temel Korkmaz'dır... Onun excel.gen.tr si efsanedir.... Çıkardığı makrolar kitabıyla Türkiye de excel alanında çığır açmıştır.

Bu yazıyı, üste ismini andığım değerli excel sevdalısı Bülent Öztürk'ün hala yayında olan (maaşallah) www.excelce.net forum sitesinde 15 Eylül 2010 tarihinde paylaştığım "Borç Takip" dosyasına yeniden tesadüf etmiş olmamdan dolayı yazdım...

Yazdığım iyi oldu, eski sevdaları ve dostları yad etmiş oldum...

 

excel vba, excel, excel örnek dosyalar


  Dasyanın açıklamasına yazdığım 2010 tarihli açıklama metni;


Aylık sabit bir maaşla çalışıyorsanız, aldığınız maaş ve her ay rutin olarak ödenen borçlarınızda maalesef sizi takip edecektir. Her ne kadar hesaplarımızı kayıt altında tutsakda dengeyi sağlamak pek mümkün olmuyor.

Eğer sizde borçlarınızı bir excel sayfasından takip etmek istiyorsanız bu küçük dosya işinize yarayacaktır. Dosyanın yaptığı işlem basit. Sadece yeşil renkli rakamları topluyor. Siz ödediğiniz veya ödeyeceğiniz borcu yeşil yapıyorsunuz, diğer hesaplama işlemleri excel vba kodları sayesinde otomatik yapılıyor.
excel vba, excel, vba, excel dosyalar

 Modules'e yazılacak kodlar:
Function ColorSum(rngCells As Range) As Double
Application.Volatile
Dim cell As Range
ColorSum = 0 'Toplamaya kaçtan başlanacak
On Error Resume Next
For Each cell In rngCells
If cell.Font.ColorIndex = 10 Then ColorSum = ColorSum + cell.Value
Next cell
End Function

Function SumColor(rColor As Range, rSumRange As Range)

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com

'Sums cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult

iCol = rColor.Interior.ColorIndex

For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = WorksheetFunction.Sum(rCell) + vResult
End If
Next rCell

SumColor = vResult
End Function

Function CountColor(rColor As Range, rSumRange As Range)

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com

'Counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult

iCol = rColor.Interior.ColorIndex

For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = vResult + 1
End If
Next rCell

CountColor = vResult
End Function 


Borç sayfasına yazılacak kodlar

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
Calculate
'Application.ScreenUpdating = True
End Sub
  1. Ahmet Bey öncelikle paylaşımlarınız çok faydalı. Ben bayağı bir araştırma yaptım bloğunuzda ama bulamadım. Acaba excel üzerinde örneğin 20 tane personelin haftanın 7 gününe eşit şekilde görevlendirme yapılması için hazır bir formül var mıdır, daha doğrusu sizin hazırladığınız bir çalışma var mı?

    YanıtlaSil
  2. Merhabalar... Excel bilgilerim güncel değil maalesef... Arşiv dosyalarımda da böyle bir dosyanın olduğunu sanmıyorum... Uğraşsak çözermiyiz büyük ihtimal ancak
    Excelce Forum Sitesinde bu
    sorununuza daha hızlı çözüm bulacağınıza inanıyorum... Yorumunuz için teşekkür ediyorum...

    YanıtlaSil

♡ Yorumlarınıza en kısa sürede geri dönüş yapılır.
♡ Üyeliğiniz yoksa dahi anonim profili seçerek yorum yapabilirsiniz.

Whatsapp Button works on Mobile Device only

Yazmaya başlayın ve aramak için Enter tuşuna basın.