Makroyla basit bir tablo

[CHEKICH]

Değerli Üstadlar;
bir listem var ve binlerce satırdan oluşmakta.
Geliş tarihine göre o tarih aralığı içinde şahıs bazında J sütunundaki kime kaç adet dosya gelmiş, o şahıs kaç dosya çıkarmış ve kalan kaç adet diye basit bir tabloya ihtiyacım var.

Yardımlarınız için şimdiden teşekkürler...

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu bir modul sayfasına kopyalayarak çalıştırınız. Bir butona da bağlayabilirsiniz

Sub derle()
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
son1 = sh1.Cells(65536, 1).End(xlUp).Row
sh2.Columns("A:D").ClearContents
sh2.Cells(1, 1) = "İsim"
sh2.Cells(1, 2) = "Gelen"
sh2.Cells(1, 3) = "Çıkan"
sh2.Cells(1, 4) = "Kalan"
For i = 1 To son1
  son2 = sh2.Cells(65536, 1).End(xlUp).Row
  Set rg = sh1.Range("J2:J" & i + 1)
  x = Application.WorksheetFunction.CountIf(rg, sh1.Cells(i + 1, 10))
  If x = 1 Then
     sh2.Cells(son2 + 1, 1) = sh1.Cells(i + 1, 10)
     sh2.Cells(son2 + 1, 2) = Application.WorksheetFunction.CountIf(sh1.Range("J2:J" & son1), sh1.Cells(i + 1, 10))
    For j = 2 To son1
       If sh1.Cells(j, 10) = sh2.Cells(son2 + 1, 1) And sh1.Cells(j, 7) <> 0 Then
       deger = deger + 1
       End If
    Next j
    sh2.Cells(son2 + 1, 3) = deger
    deger = 0
    sh2.Cells(son2 + 1, 4) = sh2.Cells(son2 + 1, 2) - sh2.Cells(son2 + 1, 3)
  End If
  Set rg = Nothing
Next i
sh2.Select
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

 

[CHEKICH]

teşekkürler fbc...
butona da atadım ama çalışmadı... örnek bir dosya ekleyebilirseniz sevinirim...

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[CHEKICH]

Teşekkürler fpc ama küçük bir sorun kalmış....
Öncelikle L sütunundaki tarihleri ay bazında ayırt edip sonra isimleri ve daha sonra da çıkanları yazması gerek.

Yani bana lazım olan; Ağustos ayında (01.08.2007-31.08.2007) tarihleri arasında ali'ye gelen dosya ve aynı tarihler arasında alinin çıkardığı dosya sayısı olmalıydı...
Bu listeyi her ay Ocak, şubat, mart ...bu şekilde almamız gerek...

 

[veyselemre]

Alternatif, ay ve yılı sayfadan veya inputboxla alabilirsiniz.

Sub Ozetle()
    ay = 8: yil = 2007
    
    Application.ScreenUpdating = False
    Set s1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    son1A = s1.[a65536].End(3).Row
    S2.[A:H].Delete
    s1.Range("G1:G" & son1A & ",J1:J" & son1A & ",L1:L" & son1A).Copy S2.[F1]
    S2.Select
    sonG = [G65536].End(3).Row
    Range("G1:G" & sonG).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[A1], Unique:=True
    [A1].Copy [A1:D1]
    [A1:D1] = [{"İsim", "Gelen",  "Çıkan" ,  "Kalan" }]
    sonA = [a65536].End(3).Row
    alan1 = Range("g2:G" & sonG).Address
    alan2 = Range("h2:H" & sonG).Address
    alan3 = Range("f2:F" & sonG).Address
    Range("B2:B" & sonA).Formula = "=SUMPRODUCT(--(MONTH(" & alan2 & ")=" & ay & "),--(YEAR(" & alan2 & ")=" & yil & "),--(" & alan1 & "=A2))"
    Range("C2:C" & sonA).Formula = "=SUMPRODUCT(--(MONTH(" & alan3 & ")=" & ay & "),--(YEAR(" & alan3 & ")=" & yil & "),--(" & alan1 & "=A2))"
    Range("D2:D" & sonA).Formula = "=B2-C2"
    Range("B2:D" & sonA).Value = Range("B2:D" & sonA).Value
    [F:H].Delete
    [A:D].EntireColumn.AutoFit
    Set s1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
End Sub

 

[CHEKICH]

sayın fbc sizin örneğiniz tam istediğim gibi ama şu tarih aralığını da belirleyerek raporu alabilirsek tam işime yarayacak...

veyselemre ilginizden dolayı sizede çok teşekkür ederim ama fbc nin örneği tam olarak istediğime yakın...

 

[AS3434]

Bir örnek de ben vereyim.

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[CHEKICH]

AS3434 VE fpc çok teşekkür ederim iki örnek de çok güzel olmuş ellerinize sağlık...