• DİKKAT

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

Listeyi aylara ayırmak

  • Konbuyu başlatan Konbuyu başlatan kralasd
  • Başlangıç tarihi Başlangıç tarihi
K

kralasd

Katılım
1 Mart 2010
Mesajlar
34
Excel Vers. ve Dili
visual basic
merhaba
Her şeyden önce çok faydalı bir site ve gerçekten sıkıştığım ve takıldığım her noktada yıllardır çözümü kolayca bulduğum bir yardımlaşma ortamı var. Emeği geçen herkese çok teşekkür ediyorum.
Bir noktada yardımınıza ihtiyacım var. Ekte liste örneği bulunan excel dosyamda da görüldüğü gibi farklı poliçeler ve farklı tarih aralıkları bulunan kişiler mevcut benim isteğim bu ana listeyi aylara ayırmak. Ancak sorun şu ki kişilerin birden fazla aracı olabiliyor.Hem araç sayısı değişken hem tarihler değişken aynı şahsın hem ocak ayında olması gerekli hemde aralık ayında bazıları 12 ayda bile olabiliyor. Hem bütün aylara gitmesini hemde bulunduğu sütünün komple var olduğu aylara kopyalanmasını istiyorum.Biraz karışık oluyor anlatınca ama eminim ki örneği gördüğünüzde daha iyi anlayacaksınız.Bana bir ipucu bile verebilecek varsa çok memnun olurum.Kişi sayısı çok fazla olduğu için el ile yapmak aylar alabilir. Herkese çok teşekkürler
 

Ekli dosyalar

Merhaba
İyi Çalışmalar
Dosyanız Ektedir.
--------------------------
Konuya Olumlu Veya Olumsuz
Dönüş Yapmanız.
Konuyu Takip Eden Diğer Site
Sakinleri Açısından Faydalı Olucaktır.
 
Son düzenleme:
Öncelikle emeğinize ve ellerinize sağlık uzun uzun inceledim.Gayet güzel çalışıyor.Bir tek eksikliği söz konusu aynı şahısın birden fazla ayda farklı poliçeleri olduğu için diğer sütunlardaki tarihlere göre de aylara gitmesini istiyoruz.Bu mümkün müdür?Şu an sadece I sütunu üzerinden aylara ayırıyor. Diğerleri için bir çözüm yolu bulunabilir mi? Tekrar teşekkürler
 
Merhaba Sayın kralasd
İyi Çalışmalar Şu Andaki Durum
X Sutunundaki Aylara Göre Dağıtım Yapıyor
Anladığım Kadarıyla Siz
9 Sutundaki Aylara Göre Dağıtım Yapmasını
İstiyorsunuz Konu Beni Aşıyor
Umarım Bir Arkadaşımız Yardımcı Olur
Kolay Gelsin İyi Çalışmalar.
 
Son düzenleme:
Evet söylediğiniz gibi bütün sütundaki aylara göre dağıtım yapmak istiyorum. Yardımlarınız için teşekkürler umarım başka bir arkadaşımız yardımcı olur.Elinize sağlık.
 
kralasd' Alıntı:
merhaba
Her şeyden önce çok faydalı bir site ve gerçekten sıkıştığım ve takıldığım her noktada yıllardır çözümü kolayca bulduğum bir yardımlaşma ortamı var. Emeği geçen herkese çok teşekkür ediyorum.
Bir noktada yardımınıza ihtiyacım var. Ekte liste örneği bulunan excel dosyamda da görüldüğü gibi farklı poliçeler ve farklı tarih aralıkları bulunan kişiler mevcut benim isteğim bu ana listeyi aylara ayırmak. Ancak sorun şu ki kişilerin birden fazla aracı olabiliyor.Hem araç sayısı değişken hem tarihler değişken aynı şahsın hem ocak ayında olması gerekli hemde aralık ayında bazıları 12 ayda bile olabiliyor. Hem bütün aylara gitmesini hemde bulunduğu sütünün komple var olduğu aylara kopyalanmasını istiyorum.Biraz karışık oluyor anlatınca ama eminim ki örneği gördüğünüzde daha iyi anlayacaksınız.Bana bir ipucu bile verebilecek varsa çok memnun olurum.Kişi sayısı çok fazla olduğu için el ile yapmak aylar alabilir. Herkese çok teşekkürler
Genişletmek için tıkla ...

Merhaba sorunuzu anlamak açısından 1 nolu mesajınızdaki bilgiler ışığında manuel olarak siz aylara göre dağılımını elle girermisiniz.
 
halit3' Alıntı:
Merhaba sorunuzu anlamak açısından 1 nolu mesajınızdaki bilgiler ışığında manuel olarak siz aylara göre dağılımını elle girermisiniz.
Genişletmek için tıkla ...

Merhaba
şahısların aynı satırdan birden fazla tarihte biten poliçeleri mevcut benim istediğim her ay için o satırın hepsini ayrı ayrı kopyalaması ekte örnek mevcuttur.teşekkürler
 

Ekli dosyalar

kralasd' Alıntı:
Merhaba
şahısların aynı satırdan birden fazla tarihte biten poliçeleri mevcut benim istediğim her ay için o satırın hepsini ayrı ayrı kopyalaması ekte örnek mevcuttur.teşekkürler
Genişletmek için tıkla ...

Kod:

Kod: 
Sub aktar()

ana_sayfa = "TRAFÝÐE GÖRE SIRALI LÝSTE"

For i = 2 To Worksheets(ana_sayfa).Cells(Rows.Count, "a").End(3).Row
For s = 1 To Worksheets(ana_sayfa).Cells(1, Columns.Count).End(xlToLeft).Column
If Worksheets(ana_sayfa).Cells(1, s).Value = "TRAFÝK" Then
If Worksheets(ana_sayfa).Cells(i, s).Value <> "" Then
aranan1 = Format(Worksheets(ana_sayfa).Cells(i, s).Value, "MMMM")
sat = Worksheets(aranan1).Cells(Rows.Count, "a").End(3).Row + 1
Worksheets(ana_sayfa).Rows(i).Copy
Sheets(aranan1).Select
Range("A" & sat).Select
ActiveSheet.Paste
'End If
End If
End If
Next s
Next i
Application.CutCopyMode = False
Sheets(ana_sayfa).Select

MsgBox "işlem tamam"
End Sub
 
"subscript out of range" hata verdi galiba yanlış bir şey yaptım.
 
halit3' Alıntı:
Kod:

Kod: 
Sub aktar()

ana_sayfa = "TRAFÝÐE GÖRE SIRALI LÝSTE"

For i = 2 To Worksheets(ana_sayfa).Cells(Rows.Count, "a").End(3).Row
For s = 1 To Worksheets(ana_sayfa).Cells(1, Columns.Count).End(xlToLeft).Column
If Worksheets(ana_sayfa).Cells(1, s).Value = "TRAFÝK" Then
If Worksheets(ana_sayfa).Cells(i, s).Value <> "" Then
aranan1 = Format(Worksheets(ana_sayfa).Cells(i, s).Value, "MMMM")
sat = Worksheets(aranan1).Cells(Rows.Count, "a").End(3).Row + 1
Worksheets(ana_sayfa).Rows(i).Copy
Sheets(aranan1).Select
Range("A" & sat).Select
ActiveSheet.Paste
'End If
End If
End If
Next s
Next i
Application.CutCopyMode = False
Sheets(ana_sayfa).Select

MsgBox "işlem tamam"
End Sub
Genişletmek için tıkla ...

galiba beceremedim :(
 
Büyük ihtimalle sayfa adı ile ilgilidir...

Sayfa adı ne ise onu buraya aynen yazın;
ana_sayfa = "TRAFÝÐE GÖRE SIRALI LÝSTE"
 
Şu satırdaki TRAFÝK kelimesini de düzeltin...

If Worksheets(ana_sayfa).Cells(1, s).Value = "TRAFÝK" Then
 
İş yerinden yazmıştım kodu evde net yok ancak şimdi yeni gördüm.
Murat Bey size yardımcı olmuş ben dosyanızı ekliyorum bu forma eklediğim kodları büyük harflerden İ harfini sistem otomatik olarak değiştirdiğinden kodlardaki harfler yanlış olmuş.

kod:

Kod: 
Sub aktar()

ana_sayfa = "[COLOR="Red"]TRAFİĞE GÖRE SIRALI LİSTE[/COLOR]"
For i = 2 To Worksheets(ana_sayfa).Cells(Rows.Count, "a").End(3).Row
For s = 1 To Worksheets(ana_sayfa).Cells(1, Columns.Count).End(xlToLeft).Column
If Worksheets(ana_sayfa).Cells(1, s).Value = "[COLOR="red"]TRAFİK[/COLOR]" Then
If Worksheets(ana_sayfa).Cells(i, s).Value <> "" Then
aranan1 = Format(Worksheets(ana_sayfa).Cells(i, s).Value, "MMMM")

sat = Worksheets(aranan1).Cells(Rows.Count, "a").End(3).Row + 1
Worksheets(ana_sayfa).Rows(i).Copy Sheets(aranan1).Range("A" & sat)

End If
End If
Next s
Next i
MsgBox "işlem tamam"
End Sub
 

Ekli dosyalar

Bu da farklı bir kod

Kod: 
Sub aktar()

Dim ay1(12)
ay1(1) = "OCAK"
ay1(2) = "ŞUBAT"
ay1(3) = "MART"
ay1(4) = "NİSAN"
ay1(5) = "MAYIS"
ay1(6) = "HAZİRAN"
ay1(7) = "TEMMUZ"
ay1(8) = "AĞUSTOS"
ay1(9) = "EYLÜL"
ay1(10) = "EKİM"
ay1(11) = "KASIM"
ay1(12) = "ARALIK"


ana_sayfa = ActiveSheet.Name
For i = 2 To Worksheets(ana_sayfa).Cells(Rows.Count, "a").End(3).Row
For s = 7 To Worksheets(ana_sayfa).Cells(1, Columns.Count).End(xlToLeft).Column Step 3

If Worksheets(ana_sayfa).Cells(i, s).Value <> "" Then
If IsNumeric(Val(Worksheets(ana_sayfa).Cells(i, s).Value)) = True Then
If IsDate(Worksheets(ana_sayfa).Cells(i, s).Value) = True Then
aranan1 = Val(Format(Worksheets(ana_sayfa).Cells(i, s).Value, "mm"))

sayfa = 0
For j = 1 To ActiveWorkbook.Sheets.Count
If Sheets(j).Name = ay1(aranan1) Then
sayfa = 1
Exit For
End If
Next

son = ActiveWorkbook.Sheets.Count
If sayfa = 1 Then
sat = Worksheets(ay1(aranan1)).Cells(Rows.Count, "a").End(3).Row + 1
Worksheets(ana_sayfa).Rows(i).Copy Sheets(ay1(aranan1)).Range("A" & sat)
Else
Sheets.Add
Sheets(ActiveSheet.Name).Move After:=Sheets(son + 1)
Sheets(ActiveSheet.Name).Name = ay1(aranan1)
sat = Worksheets(ActiveSheet.Name).Cells(Rows.Count, "a").End(3).Row + 1
Worksheets(ana_sayfa).Rows(i).Copy Sheets(ActiveSheet.Name).Range("A" & sat)
End If
End If
End If
End If
Next s
Next i
Sheets(ana_sayfa).Select

MsgBox "işlem tamam"
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst