Function Yapabilirmiyiz?

[alitolga2000]

Merhabalar,
Arkadaşlar aşağıdaki kodun sadece optionbuton3 olan yani beni ilgilendiren kısmını formül haline getirebilirmiyiz?

Private Sub listele_Click()
Dim i, y, x As Integer
Dim sutun As Integer
Dim sayac
Dim MyArray(1000, 4)
sayac = 0
Application.ScreenUpdating = False
If OptionButton1.Value = True Or OptionButton2.Value = True Then GoTo devam
If Len(giriş1) < 9 Then
MsgBox "*Tarih 1* kutusuna değer giriniz.", , "UYARI"
GoTo bitir
End If
devam:
If Len(çıkış1) < 9 Then
çıkış1 = giriş1
End If
If IsDate(giriş1) = True And IsDate(çıkış1) = True Then
If DateValue(Format(giriş1, "dd/mm/yyyy")) > DateValue(Format(çıkış1, "dd/mm/yyyy")) Then
MsgBox "İlk tarih değeri ikinci tarih değerinden büyük olmamalı", , "UYARI"
GoTo bitir
End If
End If
MyArray(0, 0) = "Sicil No"
MyArray(0, 1) = "Ad Soyad"
MyArray(0, 2) = "Toplam Gün"
MyArray(0, 3) = "Gün-Ay-Yıl"
For i = 1 To WorksheetFunction.CountA(Sheets(sayfa).Range("A:A"))
If MyArray(sayac, 0) <> "" Then
sayac = sayac + 1
End If
y = 0
Dim say As Integer
say = WorksheetFunction.CountA(Range("a1:a16000"))
ProgressBar1.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = say
ProgressBar1.Value = i
For y = 3 To WorksheetFunction.CountA(Rows("1:1"))
Cells(i + 1, y).Select
If ActiveCell = "" Then GoTo ydongusu
If OptionButton1.Value = True Then
If Cells(1, y) = "GİRİŞ" And Cells(i + 1, y + 1) = "" Then
MyArray(0, 2) = "Giriş Tarihi"
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 2) = "X"
End If
End If

If OptionButton2.Value = True Then
If Cells(1, y) = "ÇIKIŞ" And Cells(i + 1, y + 1) = "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 2) = DateDiff("d", ActiveCell.Offset(0, -1), ActiveCell)
End If
End If

If OptionButton3.Value = True Then
For x = 3 To WorksheetFunction.CountA(Rows("1:1"))
If ActiveCell.Column > WorksheetFunction.CountA(Rows("1:1")) Then GoTo xdongusu
If Cells(1, ActiveCell.Column) <> "GİRİŞ" Then ActiveCell.Offset(0, 1).Select
If ActiveCell.Offset(0, 1) <> "" And IsDate(ActiveCell.Offset(0, 1)) = True Then
If DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giriş1, çıkış1)
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, çıkış1)
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giriş1, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If
End If
xdongusu:
ActiveCell.Offset(0, 1).Select
Next x
If MyArray(sayac, 2) <> "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 3) = tarihfarki((0), (MyArray(sayac, 2)))
End If
GoTo idongusu
End If


If OptionButton4.Value = True Then

For x = 3 To WorksheetFunction.CountA(Rows("1:1"))
If ActiveCell.Column > WorksheetFunction.CountA(Rows("1:1")) Then GoTo xdongu
If Cells(1, ActiveCell.Column) <> "ÇIKIŞ" Then ActiveCell.Offset(0, 1).Select
If ActiveCell.Offset(0, 1) <> "" And IsDate(ActiveCell.Offset(0, 1)) = True Then

If DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giriş1, çıkış1)
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, çıkış1)
GoTo xdongusu
End If

If DateValue(Format(giriş1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(çıkış1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(giriş1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giriş1, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If
End If
xdongu:
ActiveCell.Offset(0, 1).Select
Next x
If MyArray(sayac, 2) <> "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 3) = tarihfarki((0), (MyArray(sayac, 2)))
End If
GoTo idongusu
End If
ydongusu:
Next y
idongusu:
Next i
ListBox1.List() = MyArray()
Label5 = sayac - 1
bitir:
Application.ScreenUpdating = True
End Sub