Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Haziran 2005 Pazartesi

To Prevent Duplicates To Enter

'Module1

Option Explicit
Dim i As Single
Dim Durdur As Boolean

Sub EngellemeyiBaşlat() '[to block start]
On Error Resume Next
Durdur = False
Call ÇiftKayıtGirmeyiEngelle
End Sub
Sub ÇiftKayıtGirmeyiEngelle() '[To prevent duplicates to enter]
On Error Resume Next
For i = [A65536].End(3).Row To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, "A")) > 1 Then Rows(i).ClearContents
Next
Application.OnTime (VBA.Now + TimeSerial(0, 0, 1)), "ÇiftKayıtGirmeyiEngelle"
End Sub
Sub EngellemeyiDurdur() '[to block stop]
On Error Resume Next
Durdur = True
End Sub

10 Haziran 2005 Cuma

Resize Range

'Module1

Option Explicit

Sub GenişletilmişSeçiliAlan() '[Resize Range]
On Error Resume Next
Range("C4").Resize(6, 9).Select
End Sub

1 Haziran 2005 Çarşamba

Learn Your Age






'Module1

Dim Hesaplama As Boolean
Sub YaşınızıÖğrenin()
'Learn your age

On Error Resume Next
If MsgBox("Yaşınızı detaylı hesaplamak istiyor musunuz?", vbYesNo, "[PBİD®] Yıllık veya Detaylı [Yıl,Ay,Gün] Hesaplama") = vbYes Then
MsgBox DetayYaşHesabı(VBA.InputBox("Doğum tarihiniz [gg/aa/yyyy]", "[PBİD®] Detaylı Yaş Hesabı")) & vbNewLine & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] Hesaplanan Yaşınız..."
Else
MsgBox YıllıkYaşHesabı(VBA.InputBox("Doğum tarihiniz [gg/aa/yyyy]", "[PBİD®] Yıllık Yaş Hesabı")) & vbNewLine & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] Hesaplanan Yaşınız..."
End If
End Sub
Function YıllıkYaşHesabı(DoğumTarihi As Date)
'Calculate Year

On Error GoTo Son
DoğumTarihi = VBA.CDate(DoğumTarihi)
DoğumYıl = VBA.Year(DoğumTarihi)
DoğumAy = VBA.Month(DoğumTarihi)
DoğumGün = VBA.Day(DoğumTarihi)
BugünYıl = VBA.Year(VBA.Date)
BugünAy = VBA.Month(VBA.Date)
BugünGün = VBA.Day(VBA.Date)
If DoğumAy > BugünAy Then YıllıkYaşHesabı = BugünYıl - DoğumYıl - 1
If BugünAy = DoğumAy Then
If BugünGün >= DoğumGün Then
YıllıkYaşHesabı = BugünYıl - DoğumYıl
Else
YıllıkYaşHesabı = BugünYıl - DoğumYıl - 1
End If
End If
If BugünAy > DoğumAy Then YıllıkYaşHesabı = BugünYıl - DoğumYıl
YıllıkYaşHesabı = YıllıkYaşHesabı & " yıl"
Exit Function
Son:
YıllıkYaşHesabı = ""
End Function
Function DetayYaşHesabı(DoğumTarihi)
'Calculate Year, Month, Day

On Error GoTo Son
DoğumTarihi = VBA.CDate(DoğumTarihi)
DoğumYıl = VBA.Year(DoğumTarihi)
DoğumAy = VBA.Month(DoğumTarihi)
DoğumGün = VBA.Day(DoğumTarihi)
BugünYıl = VBA.Year(VBA.Date)
BugünAy = VBA.Month(VBA.Date)
BugünGün = VBA.Day(VBA.Date)
Yıl = BugünYıl - DoğumYıl
If DoğumAy > BugünAy Then Yıl = Yıl - 1
If BugünAy = DoğumAy And DoğumGün > BugünGün Then Yıl = Yıl - 1
Ay = BugünAy - DoğumAy
If DoğumAy >= BugünAy Then Ay = 12 + Ay
If DoğumGün > BugünGün Then Ay = Ay - 1
If Ay = 12 Then Ay = 0
AyGünü = VBA.Day((VBA.DateSerial(BugünYıl, BugünAy, 1) - 1))
Gün = BugünGün - DoğumGün
If DoğumGün > BugünGün Then Gün = AyGünü - DoğumGün + BugünGün
DetayYaşHesabı = Yıl & " Yıl, " & Ay & " Ay, " & Gün & " gün."
Exit Function
Son:
DetayYaşHesabı = ""
End Function

Blog Arşivi

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul
Anadolu Üniversitesi Açık Öğretim Fakültesi