muhsar
Altın Üye
- Katılım
- 16 Mart 2019
- Mesajlar
- 262
- Excel Vers. ve Dili
- 2010 tütkçe
- Altın Üyelik Bitiş Tarihi
- 21-03-2029
Kod:
Private Sub CommandButton1_Click()
Dim sf As Worksheet, sh As Worksheet
Set sf = Sheets("Aidat")
son = sf.Range("A" & Rows.Count).End(3).Row
a = sf.Range("B2:D" & son).Value
If son < 2 Then MsgBox "Yetersiz tablo.", vbCritical: Exit Sub
Set sh = Sheets("icmal")
sh.Range("A3:N" & Rows.Count) = ""
sh.Range("A3:N" & Rows.Count).ClearFormats
Set dc1 = CreateObject("scripting.dictionary")
Set dc2 = CreateObject("scripting.dictionary")
yil = [E1]
For i = 1 To UBound(a)
If Year(a(i, 2)) = yil Then
ay = Val(Month(a(i, 2)))
ad = a(i, 1): dc1(ad) = ""
tutar = ad & "|" & ay: dc2(tutar) = dc2(tutar) + a(i, 3)
End If
Next i
If dc1.Count > 0 Then
say = say + 1
ReDim b(1 To dc1.Count + 3, 1 To 14)
For j = 1 To 12
b(say, j + 1) = Format("1." & j, "mmmm")
Next j
ww = dc1.keys
For i = 1 To dc1.Count
say = say + 1
b(say, 1) = ww(i - 1)
For j = 1 To 12
krt = ww(i - 1) & "|" & j
b(say, j + 1) = dc2(krt)
b(say, 14) = b(say, 14) + dc2(krt)
b(dc1.Count + 3, j + 1) = b(dc1.Count + 3, j + 1) + b(say, j + 1)
Next j
b(dc1.Count + 3, 14) = b(dc1.Count + 3, 14) + b(say, 14)
Next i
sh.[B4].Resize(say + 1, 13).NumberFormat = "#,##0.00"
sh.[A3].Resize(say, 14).Borders.Color = RGB(1, 0, 1)
sh.[A3].Offset(say + 1).Resize(, 14).Borders.Color = RGB(1, 0, 1)
sh.[A3].Resize(say + 2, 14) = b
sh.[A3].Offset(say + 1) = "Toplam"
sh.[B3].Resize(say, 13).HorizontalAlignment = xlCenter
sh.Select
MsgBox "İşlem Bitti.", vbInformation
End If
End Sub
=EĞERHATA(EĞER(A4="";"";DÜŞEYARA(A4;borç!$B$2:$C$21;2;YANLIŞ)-N4);"")
Ekli dosyalar
-
31.2 KB Görüntüleme: 4