• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Verileri yazılı dönemdeki verleri süzüp toplamını alma

Katılım
23 Şubat 2007
Mesajlar
1,212
Excel Vers. ve Dili
Excel2003
Selamlar,
Ekteki dosyada "ÇALIŞMA" isimli sayfada:
B sütununda tarihler,
E sütununda yapılan işler,
F sütununda sefer sayıları var.

"FİRMA" isimli sayfada:
D2 Hücresinde dönem yazılı (2012-01 gibi)
Dönem seçildiğinde o döneme ait "ÇALIŞMA" E sütunundaki yapılan işler teke indirilip "FİRMA"A sütununa A3 hücresinden aşağı doğru özetlenecek.

B3 ten itibaren yanına sefer sayıları toplanacak.

Yapabilen arkadaşlar ilgilenirlerse sevinirim.
 

Ekli dosyalar

Lütfen dosyanızı tekrardan inceler misiniz_?
Yazdığınız mesajla tutmayan bilgiler var.
Ayrıca nasıl veriler gelecek örneklerle anlatırsanız yardımcı olmaya çalışırım.
 
Sayın asi_kral_1967 önce teşekkür ederim cevabınız için. Yapılan işler (E sütunu) her firma için defalarca tekrarlanmakta. Belirtilen dönemde tekrarlanan isimler teke indirilecek. O isimlere ait o dönem toplamları yB sütununda eşleşecek.
 
Sayın Kelkitli
Dosyadaki örnekler tutmuyor. Lütfen dosyadaki örnekleri düzeltin sonuçları göreyim kodu yazıp göndereyim.
 
4. Ay verileri örnektedir

Merhaba
Boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub döneli_veri_bul_aktar_1967()
'Konu       :   Dönemine Göre Veri Bul Aktar
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Worksheet, kurban As Long
Dim a As Long, b As New Collection, c As Range, d As Long
Dim yıl As Variant, ay As Variant
Application.ScreenUpdating = False
On Error Resume Next
Set asi = Sheets("FİRMA"): Set kral = Sheets("ÇALIŞMA")
asi.Range("A3:C" & Rows.Count).ClearContents
yıl = Mid(asi.Range("D2"), 1, 4)
ay = Mid(asi.Range("D2"), 6, Len(asi.Range("D2")) - 5) * 1
a = kral.Range("A" & Rows.Count).End(xlUp).Row
d = 3
kral.Range("A1:L" & a).AutoFilter field:=2, Criteria1:=">=" & CLng( _
DateSerial(yıl, ay, 1)), Operator:=xlAnd, Criteria2:="<=" & CLng( _
DateSerial(yıl, ay + 1, 0))
For kurban = 2 To a
If kral.Range("A" & kurban).EntireRow.Hidden <> True Then
b.Add kral.Cells(kurban, "E"), CStr(kral.Cells(kurban, "E"))
End If: Next
For Each c In b
kral.Range("A1:L" & a).AutoFilter field:=2, Criteria1:=">=" & CLng( _
DateSerial(yıl, ay, 1)), Operator:=xlAnd, Criteria2:="<=" & CLng( _
DateSerial(yıl, ay + 1, 0))
kral.Range("A1:L" & a).AutoFilter field:=5, Criteria1:=c
asi.Range("A" & d) = c
asi.Range("B" & d) = WorksheetFunction.Subtotal(9, kral.Range("F2:F" & a))
kral.Range("A1:L" & a).AutoFilter
asi.Range("C" & d) = WorksheetFunction.SumIf(kral.Range("E:E"), c, kral.Range("F:F"))
d = d + 1
Next
Application.ScreenUpdating = True
MsgBox asi.Range("D2") & " Dönem Verilerini Aktardım", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte.
 

Ekli dosyalar

Son düzenleme:
Sayın asi_kral_1967,
şöyle bir ekleme yapabilirmisiniz? C sütununu o firmaya ait tüm seferlerin toplamı.
 
Geri
Üst