listeleme hk.

[nongeyikm]

Sn. arkadaşlar,

Ekli dosyada 3 güne ait örnek puantaj yaptım. Bu puantajların sayısı her ayın günleri sayısında olacak. Günü geldikçe manuel olarak oluşturacağım. Amacım dosya içindeki tüm sayfalarda yer alan sicillerin F12:Y48 aralığındaki değerlerini toplayarak İCMAL sayfasında ve belirttiğim formatta (çizgiler olmayacak) listelemek.

İCMAL sayfasında örneği gösterdim.

Not : sayfalardaki X değeri sayarak icmal sayfasında toplanmalı.

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

 

[nongeyikm]

sanırım üstadlarımız burada yoklar

 

[Ömer BARAN]

Merhaba.

-- İCMAL sayfası ile diğer sayfaların birebir aynı yapıda olduğu,
-- İCMAL sayfası ile diğer sayfalardaki personel listelerinin de birebir aynı (sıralaması dahil) olduğu
varsayılırsa İCMAL sayfasına ekleyeceğiniz bir düğme/şekil ile aşağıdaki kod'u ilişkilendirerek kullanabilirsiniz.
.

[B]Sub ICMAL()[/B]
Set i = Sheets("İCMAL")
i.Range("B12:Y47").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For shf = 1 To Sheets.Count
    If Sheets(shf).Name <> "İCMAL" Then _
    Sheets(shf).Range("B12:E47").Copy i.Cells(i.Cells(Rows.Count, "BA").End(3).Row + 1, "BA")
Next
ison = i.Cells(Rows.Count, "BA").End(3).Row
i.Range("BA2:BD" & ison).Sort i.[BA1], xlAscending
i.Range("BA2:BD" & ison).RemoveDuplicates Columns:=1, Header:=xlNo
i.Range("BA2:BD" & i.Cells(Rows.Count, "BA").End(3).Row).Copy
i.[B12].PasteSpecial Paste:=xlPasteValues
i.Range("BA2:BD" & ison).Clear

For sat = 12 To i.[B11].End(xlDown).Row
    For shf = 1 To ThisWorkbook.Worksheets.Count
        If Sheets(shf).Name <> "İCMAL" Then
            sson = Sheets(shf).[B11].End(xlDown).Row
            If WorksheetFunction.CountIf(Sheets(shf).Range("B12:B" & sson), i.Cells(sat, "B")) > 0 Then _
                ssat = WorksheetFunction.Match(i.Cells(sat, "B"), Sheets(shf).Range("B12:B" & sson), 0)
                For sut = 6 To 25
                    If Sheets(shf).Cells(ssat + 11, sut) = "X" Then
                        say = say + 1
                        If say > 0 Then i.Cells(sat, sut) = i.Cells(sat, sut) + say: say = 0
                    ElseIf IsNumeric(Sheets(shf).Cells(ssat + 11, sut)) Then
                        deg = deg + Sheets(shf).Cells(ssat + 11, sut)
                        If deg > 0 Then i.Cells(sat, sut) = i.Cells(sat, sut) + deg: deg = 0
                    End If
                Next
        End If
    Next
Next
i.[A9].Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]

 

[nongeyikm]

Günaydın,

Sn. Ömer BARAN,

Konuyu açtığımda eksik anlattığım için özür dilerim. Makronuz harika bir şekilde çalıştı fakat;

Diğer sayfalardaki personeller gerek satır numarası gerekse isim olarak farklılık gösterebilir. Malum işe giriş-çıkışlardan dolayı ilaveler-eksilmeler ve bazı nedenlerden kaynaklı sıralamada değişiklikler olabilir. Dolayısı ile İCMAL sayfası B12 den itibaren boş olup, tüm verileri İCMAL sayfasına yapacağınız makro Sicil No'yu dikkate alarak verileri getirmeli. İsteğimin hiç de kolay olmadığını ve olayı zorlaştırdığının farkındayım.

Saygılar sunarım,

(5 gündür İşyerimde olmadığımdan dolayı geç yanıt verdim. kusura bakmayın)

 

[nongeyikm]

Ömer Bey günaydın,

Zamanınız olursa ilgilenebilirmisiniz?

 

[Ömer BARAN]

Tekrar merhaba.

Sayfayı yenileyerek önceki kod cevabımı tekrar kontrol edin.

Kod'un yeni hali;

-- İCMAL dışındaki sayfaların B:E sütunlarındaki sicil/ad soyad.... bilgilerini İCMAL sayfası BA:BD sütununa aktarır,
-- Bu bilgileri SİCİL numarasına göre sıralar,
-- Mükerrer olanları silerek tekrarsız hale getirir,
-- BA:BD sütunlarında elde edilen bilgiler, B:E sütunundaki yerine aktarıp, BA:BE'deki geçici listeyi siler.
-- Sonra da asıl işleme başlayarak, SİCİL numarasından hareketle istenilen sayma/toplama işlemini yapar.

Kod'un yeni halini deneyiniz.
NOT: Varsa İCMAL sayfası BA:BE sütunlarındaki bilgilerinizi başka alana almadan kodu çalıştırmayın.
.

 

[Ssu85]

Merhaba benim 2 ayrı excell tablosunda aynı olan firma isimlerini ve diger tablolarda olmayan firma isimlerini ayrı ayrı listelemem gerekli.
Söyleki biz bir kozmetik firmasıyiz son 2 yılda hergün hangi firmaya ne ürünü verilmiş excell de tutulmuş
Yani
Tarih sütununda 2 ocak 2016
Firma sutununda x eczanesi
Satılan ürün y krem gibi
Benim istediğim satılan ürünle ilgili değil
2016 yılında gidilen x Eczanesine 2017 de uru n satılmış mi yani 2017 excell tablosunun firma stununda x Eczanesi adı yazıyor mu? Bunu bulmak bunları varsa ayrı excell sayfasına aktarmak yoksa onuda ayrı excell sayfasına aktarmak. TamamEn firmamiza yeni kurum bağlanmış mi eski kurumlarla çalışıyor muyuz bunun listesini karşılaştırmak veri çok fazla....

 

[YUSUF44]

Bunun için örnek dosya eklerseniz iyi olur. Dosyanızın bir sayfasında 2016 yılı verileri, bir sayfasında da 2017 verileri olsun. Bu şekilde istediğiniz sonucu elde edebilirsiniz.

 

[Ssu85]

Dosya şuan kullandığımız programdan excellent çekiliyor aslında benim işim çıkan raporu yorumlamak ama maalesef bizim program istediğim elemeye yapamadığı için karşılaştırmayi da benim yapmam gerekiyor. Bu işin bir formülü yok mu ya da excell dosyasını pazartesi kime mail atabilir ileri excell bilen kim bana yardımcı olabilir

 

[YUSUF44]

Belirttiğim gibi bu iş yapılabilir. Formülü de var makrosu da var. Ancak ezbere bir şey yapılamaz. Formül ya da makroları excel dosyalarına göre yazılırlar. Görmediğimiz bir şey için standart bir uygulama yok maalesef.

Örnek dosyayı imzamda belirttiğim gibi paylaşabilirsiniz.

 

[Ssu85]

Merhaba
Size konuyu şöyle izah edeyim listeler henüz hazır değil biz bir program kullanıyoruz oradan excelle aktarılacak pazartesi günü
Olay şu 01.01.2016 ve 31.12.2016 ve 01.01.2017 ve 31.12.2017 olmak üzere iki ayrı excell dosya programdan çekilecek. Programdan çektiğim excell dosyalarında
Tarih, firma adı yazılı (gün gün olduğu ve cok sayida Firma olduğu için veri çok fazla)
Benim yapmam gereken analiz bu iki yılı karşılaştırmak
Karşılaştırmak istediğim şey iki başlık
1. 2016 yılında yazılı olan firma 2017 de yazılı mi? Yazılı olanları bulmak ( renk vermek)
2. 2016 yılında yazılı olan firma 2017 yılında yazılı değilse bunu bulmak (renk vermek)
Nasıl yapabilirim
Tek tek firma adı yazıp ctrl f yapmak imkansız!!!!!!
Aslında bir 3. Başlık da var ki 2016 yılında aynı firmaya 1000 defa gidilmiş olabilir o yüzden aynı çalışma sayfası içinde de aynı isimde olanları silmem lazım. (2017 yılı excell dosyası içinde aynı gecerli)
Amaç 2016 yılında gidilen firmaları çıkarmak bu birinci konu o yüzden (3. Başlıktan bahsettim)
2. Konu 2016 da gidilen firmaya 2017 de gidilmişmi gidilmiştir ise atıyorum bunlara kırmızı renk gidilmesi olanlarada sarı renk verilmesi....
çok ihtiyacım var yardıma

 

[Ssu85]

İsterseniz ben örnek bir liste yapıp ekleyeyim suan liste hazır dgl çünkü siz formül konusunda bana yardımcı olursunuz bende ona göre hazırlanan dosyada o formüller analuz yaparım. Yardımcı olursanız çok sevinirim cidden gözümde büyüdü bilmediğim icin

 

[YUSUF44]

Gerçek dosya yüklemenizi istemiyor ve beklemiyoruz. Yükleyeceğiniz dosyanın asıl dosyanızla birebir aynı yapıda olması yeterli. İçinde gerçek veri olmasına da gerek yok. Nasıl bir çözüm uygulayacağımız dosya yapısına göre değişir çünkü.

 

[Ssu85]

Tamam ben hazırlayıp hemen ekleyecegim çok teşekkür ederim

 

[Ssu85]

https://www.dosyaupload.com/qcnN

Çalışma dosyasında yapılacaklar:



Ekteki dosyada 3 ayrı sayfa var 2015, 2016 ve 2017 olmak üzere...
3 dosyada 2 sütun bulunmaktadır. Sütunlardan ilki tarih 2. sütunda kurum


1. işlem: Kurum sütununda aynı isime sahip olanların satırlarının silinmesi (Not: Yalnız burada bir handikap var mesela 2017 sayfasında hem GÜL BİJUTERİ var hem GÜL PARFÜMERİ aynı isime sahip olmaktan kastım içinde GÜL geçen satırların silmesi değil GÜL BİJUTERİ geçen satırların silinmesi)
2. işlem: Kurum sütununda WATSONS yazan tüm satırların silinmesi (Not: 2016 sayfasında hem WATSONS ETİMESGUT var hem de WATSONS KEÇİÖREN var. Ben bu firmayı listemde görmek istiyorum bu nedenle içinde WATSONS geçen tüm satırları silmek istiyorum)


1. ve 2. işlem hem 2015 hem 2016 hem de 2017 sayfası için yapılacak.


Listede bu temizleme işleminden sonra yapılacak olanlar ise:


3. işlem: 2015 sayfasında yer alan ASYA ECZANESİ 2016 sayfasında ve 2017 sayfasına geçiyor mu? (geçiyor ise o satır kırmızı olacak)
4.işlem: 2015 sayfasında yer alan (KALE ECZANESİ gibi) ancak 2016 ve 2017 sayfasında yer almayan firmaların satırlarının sarı olması
5. işlem: her sayfa için de sarıları ve kırmızıları filtreleme özelliğinin olması sadece kırmızıları göster ya da sarıları göster gibi bir filtreleme


Bilmem anlatabildim mi özet olarak çıkacak listede yapacağım çalışma bu
Yardımcı olursanız çok sevinirim

 

[Ssu85]

Son olarak ben kırmızı ve sarı renklenmeden bahsediyorum ama o olmasa da olur istediğim şey aslında filtreleme

 

[YUSUF44]

Aşağıdaki kodları kopyalayın.
Dosyanızda Alt+F11 yapın, VBA penceresi açılacaktır.
Insert menüsünden Module'yi seçin ve kopyaladığınız kodları açılan boş sayfaya yapıştırın.
Excel dosyanıza geçin
Dosyanıza bir düğme/resim/nesne vs ekleyin
Eklediğiniz düğme/resim/nesneye sağ tıklayıp makro ata deyin
Açılan pencerede düzenle adlı makroyu seçin ve tamam deyin
F12 tuşuna basarak farklı kaydetme menüsünü açın
Dosya türü olarak Makro İçerebilen Excel Dosyası türünü seçin ve dosyanızı kaydedin

Bundan sonra o düğme/nesne/resme tıkladığınızda makro çalışacak ve istediğiniz düzenlemeleri yapacaktır:

Sub düzenle()
Set s1 = Sheets("2015")
Set s2 = Sheets("2016")
Set s3 = Sheets("2017")

eski15 = s1.Cells(Rows.Count, "B").End(3).Row
eski16 = s2.Cells(Rows.Count, "B").End(3).Row
eski17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Range("$A$1:$B$" & eski15).RemoveDuplicates Columns:=2, Header:=xlYes
s2.Range("$A$1:$B$" & eski16).RemoveDuplicates Columns:=2, Header:=xlYes
s3.Range("$A$1:$B$" & eski17).RemoveDuplicates Columns:=2, Header:=xlYes

yeni15 = s1.Cells(Rows.Count, "B").End(3).Row
yeni16 = s2.Cells(Rows.Count, "B").End(3).Row
yeni17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Activate
    For i = yeni15 To 2 Step -1
        If Left(s1.Cells(i, "B"), 7) = "WATSONS" Then
            s1.Rows(i).Delete shift:=xlUp
            GoTo 10
        Else
            If WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s1.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s1.Cells(i, "B")) = 0 Then
                s1.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s1.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
10:
    Next
s1.[B1].AutoFilter
s2.Activate
    For i = yeni16 To 2 Step -1
        If Left(s2.Cells(i, "B"), 7) = "WATSONS" Then
            s2.Rows(i).Delete shift:=xlUp
            GoTo 20
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s2.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s2.Cells(i, "B")) = 0 Then
                s2.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s2.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
20:
    Next
s2.[B1].AutoFilter

s3.Activate
    For i = yeni17 To 2 Step -1
        If Left(s3.Cells(i, "B"), 7) = "WATSONS" Then
            s3.Rows(i).Delete shift:=xlUp
            GoTo 30
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s3.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s3.Cells(i, "B")) = 0 Then
                s3.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s3.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
30:
    Next
s3.[B1].AutoFilter
End Sub

Makro sonunda sayfalarda filtre yoksa filtreleme açılacaktır. Açılmasa da Veri menüsünden siz filtrelemeyi açabilirsiniz. 2007 sürümünde var mı bilmiyorum ancak muhtemelen 2010 ya da üst versiyon excel kullanıyorsanız sütunlarda renge göre filtreleme yapabilirsiniz.

 

[Ssu85]

Bahsettigim işlem sanırım excell de olmuyor makrodan destek almam lazım
Onuda ben bilmiyorum ama denerim
Yalnız şunu anlamadım
1.kodu nereye ekliyorum
2.düğme/resim/nesne ne oluyor

 

[YUSUF44]

Kodu eklemeyi bir önceki mesajımda adım adım anlatmıştım.

Excelde ekle menüsünü incelerseniz resim ekle gibi özellikleri görebilirsiniz.

 

[Ssu85]

Teşekkürler deneyip bilgi vereceğim