- Katılım
- 15 Temmuz 2012
- Mesajlar
- 4
- Excel Vers. ve Dili
- all
- Altın Üyelik Bitiş Tarihi
- 25-11-2023
Yıllık izin formülünde bayramları çalışma sayfasından değil de, aynı klasör içinde bulunan başka bayramlar isimli excel'den almasını istiyorum. Bununla alakalı yardımcı olabilecek arkadaşlar var mıdır?
Sub hesapla()
Dim i, r, j, sut1, son3, deg, say
Dim tarih1, gün1
Dim data1, data2
sut1 = 1
Dim ZBasla, zaman, zBitis
ZBasla = TimeValue(Now)
zaman = Timer
Application.Calculation = xlManual
For j = 2 To Worksheets("data").Cells(Rows.Count, "a").End(3).Row
say = 0
tarih1 = Worksheets("data").Cells(j, 1)
If IsDate(tarih1) = False Then
MsgBox "Tarih boş"
GoTo Atla2
Exit For
End If
gün1 = Worksheets("data").Cells(j, 2)
If IsNumeric(gün1) = False Then
MsgBox "Gün boş"
GoTo Atla2
Exit For
End If
Dim m As Date
son3 = 0
data1 = CDate(tarih1)
data2 = Val(gün1)
deg = 0
For i = 0 To 500
If son3 > data2 Then Exit For
m = data1 + i
For r = 2 To Worksheets("bayramlar").Cells(Rows.Count, "a").End(3).Row
If m = Sheets("bayramlar").Cells(r, 1).Value Then
say = say + 1
GoTo Atla1
Exit For
End If
If Format((m), "dddd") = Sheets("bayramlar").Cells(r, 1).Value Then
say = say + 1
GoTo Atla1
Exit For
End If
Next r
If "01.01" = Format((m), "dd/mm") Or "23.04" = Format((m), "dd/mm") _
Or "01.05" = Format((m), "dd/mm") Or "19.05" = Format((m), "dd/mm") _
Or "30.08" = Format((m), "dd/mm") Or "15.07" = Format((m), "dd/mm") _
Or "29.10" = Format((m), "dd/mm") Then
say = say + 1
GoTo Atla1
End If
deg = CDate((m))
son3 = son3 + 1
Atla1:
Next i
Worksheets("data").Cells(j, 3).Value = deg
Worksheets("data").Cells(j, 4).Value = i - 1
Worksheets("data").Cells(j, 5).Value = say
Atla2:
Next j
Application.Calculation = xlAutomatic
zBitis = TimeValue(Now)
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"
End Sub
Sub hesapla()
Dim i, r, j, sut1, son3, deg, say
Dim tarih1, gün1
Dim data1, data2
sut1 = 1
Dim ZBasla, zaman, zBitis
ZBasla = TimeValue(Now)
zaman = Timer
Application.Calculation = xlManual
For j = 2 To Worksheets("data").Cells(Rows.Count, "a").End(3).Row
say = 0
tarih1 = Worksheets("data").Cells(j, 1)
If IsDate(tarih1) = False Then
MsgBox "Tarih boş"
GoTo Atla2
Exit For
End If
gün1 = Worksheets("data").Cells(j, 2)
If IsNumeric(gün1) = False Then
MsgBox "Gün boş"
GoTo Atla2
Exit For
End If
Dim m As Date
son3 = 0
data1 = CDate(tarih1)
data2 = Val(gün1)
deg = 0
For i = 0 To 500
If son3 > data2 Then Exit For
m = data1 + i
For r = 2 To Worksheets("bayramlar").Cells(Rows.Count, "a").End(3).Row
If m = Sheets("bayramlar").Cells(r, 1).Value Then
say = say + 1
GoTo Atla1
Exit For
End If
If Format((m), "dddd") = Sheets("bayramlar").Cells(r, 1).Value Then
say = say + 1
GoTo Atla1
Exit For
End If
Next r
If "01.01" = Format((m), "dd/mm") Or "23.04" = Format((m), "dd/mm") _
Or "01.05" = Format((m), "dd/mm") Or "19.05" = Format((m), "dd/mm") _
Or "30.08" = Format((m), "dd/mm") Or "15.07" = Format((m), "dd/mm") _
Or "29.10" = Format((m), "dd/mm") Then
say = say + 1
GoTo Atla1
End If
deg = CDate((m))
son3 = son3 + 1
Atla1:
Next i
Worksheets("data").Cells(j, 3).Value = deg
Worksheets("data").Cells(j, 4).Value = i - 1
Worksheets("data").Cells(j, 5).Value = say
Atla2:
Next j
Application.Calculation = xlAutomatic
zBitis = TimeValue(Now)
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"
End Sub