Listeyi aylara ayırmak

[kralasd]

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

 

[ZorBey_]

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.

 

[kralasd]

Ö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

 

[ZorBey_]

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.

 

[kralasd]

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.

 

[halit3]

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

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.

 

[kralasd]

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.

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

 

[halit3]

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

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

 

[kralasd]

"subscript out of range" hata verdi galiba yanlış bir şey yaptım.

 

[kralasd]

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

galiba beceremedim

 

[Murat OSMA]

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"

 

[kralasd]

büyük ihtimalle sayfa adı ile ilgilidir...

Sayfa adı ne ise onu buraya aynen yazın;
ana_sayfa = "trafÝÐe göre sıralı lÝste"

bu seferde işlem tamam diyor ancak hiçbir işlem yapmıyor :s

 

[Murat OSMA]

Şu satırdaki TRAFÝK kelimesini de düzeltin...

If Worksheets(ana_sayfa).Cells(1, s).Value = "TRAFÝK" Then

 

[halit3]

İş 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:

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

 

[halit3]

Bu da farklı bir 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