Aşağıdaki kod çalıştırıldığında aktif hücre siliniyor. Hatayı göremedim. Yardımcı olursanız sevinirim.
Sub deneme()
Dim a As Double, b As Double
Dim c As String
Dim d As Date
a = InputBox("kirayı giriniz:")
b = InputBox("tahsilat tutarını giriniz:")
c = InputBox("ödeme şeklini giriniz:")
d = InputBox("ödeme tarihini giriniz:")
Range("a2").Select
Selection = bolme(a, b, c, d)
End Sub
Function bolme(kira As Double, tahsilat As Double, kanal As String, tarih As Date)
Dim adet As Integer, i As Integer, j As Integer
If ActiveCell.Offset(0, 1).Value = 0 Then
ActiveCell.Select
Else
Do Until ActiveCell.Offset(0, 1).Value = 0
ActiveCell.Offset(1, 0).Select
Loop
End If
If tahsilat = kira Then
ActiveCell.Value = kira
ActiveCell.Offset(0, 1).Value = kanal
ActiveCell.Offset(0, 2).Value = tarih
ElseIf tahsilat > kira Then
adet = tahsilat / kira
For i = 0 To adet - 1
ActiveCell.Offset(i, 0).Value = kira
ActiveCell.Offset(i, 1).Value = kanal
ActiveCell.Offset(i, 2).Value = tarih
Next i
End If
End Function
Sub deneme()
Dim a As Double, b As Double
Dim c As String
Dim d As Date
a = InputBox("kirayı giriniz:")
b = InputBox("tahsilat tutarını giriniz:")
c = InputBox("ödeme şeklini giriniz:")
d = InputBox("ödeme tarihini giriniz:")
Range("a2").Select
Selection = bolme(a, b, c, d)
End Sub
Function bolme(kira As Double, tahsilat As Double, kanal As String, tarih As Date)
Dim adet As Integer, i As Integer, j As Integer
If ActiveCell.Offset(0, 1).Value = 0 Then
ActiveCell.Select
Else
Do Until ActiveCell.Offset(0, 1).Value = 0
ActiveCell.Offset(1, 0).Select
Loop
End If
If tahsilat = kira Then
ActiveCell.Value = kira
ActiveCell.Offset(0, 1).Value = kanal
ActiveCell.Offset(0, 2).Value = tarih
ElseIf tahsilat > kira Then
adet = tahsilat / kira
For i = 0 To adet - 1
ActiveCell.Offset(i, 0).Value = kira
ActiveCell.Offset(i, 1).Value = kanal
ActiveCell.Offset(i, 2).Value = tarih
Next i
End If
End Function
