İki tarih arasındaki verileri ayrı bir alana listelemek

I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhabalar,

Ekteki tabloda LISTE sayfasındaki PERSONEL in karşısında olan MÜŞTERİ alanıyla ÜRÜN İSMİ ni birleştirerek, BAŞLANGIÇ ve TESLİM tarihlerine göre TAKVIM sayfasına listeleyen bir tablo oluşturmak istiyorum. Örnek olarak TAKVİM sayfasında elle girdiğim alanı otomatik listeleyeb bir yapı istiyorum. Bu konuda yardımcı olabilirseniz sevinirim.
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

TAKVİM sayfasında günlerin bulunduu alanda bir gün için en fazla kaç satır veri olabilir. Eğer makul bir sınırı varsa formülle çözüm üretilebilir.

Aksi durumda makro kullanmak daha uygun gibi görünüyor.
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhaba Hocam,

Geri dönüşünüz için çok teşekkür ederim. TAKVİM sayfasına bir gün için maksimum 10 veri satırı olması yeterlidir.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Aşağıdaki formül ile 5 satırlık bir veri dizisi oluşmaktadır. 10 satır için formülü uzatmak gerekecektir. Fakat çok mantıklı olacağını düşünmüyorum.

DİZİ formüldür. Formülü hücreye yazdıktan sonra hücreyi CTRL+SHIFT+ENTER tuşlarına basarak terk ediniz. Aksi halde doğru sonuç üretmez.

Formül LISTE sayfasındaki 1000 satırı kontol etmektedir. Dilerseniz genişletebilirsiniz.

Kod: 
=EĞERHATA("* "&İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));1);1);"")&" "&EĞERHATA(İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));1);2);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));2);1);"")&" "&EĞERHATA(İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));2);2);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));3);1);"")&" "&EĞERHATA(İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));3);2);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));4);1);"")&" "&EĞERHATA(İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));4);2);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));5);1);"")&" "&EĞERHATA(İNDİS(LISTE!$A$1:$E$1000;KÜÇÜK(EĞER(LISTE!$C$1:$C$1000=$A2;EĞER(B$1>=LISTE!$D$1:$D$1000;EĞER(B$1<=LISTE!$E$1:$E$1000;SATIR(LISTE!$A$1:$A$1000))));5);2);"")
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Hocam şuan için istediğim şekilde çalışıyor. Değerli desteğiniz için çok teşekkür ederim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Tekrar Merhaba,

Verileriniz çoğaldığında formüller sonucunda yavaşlama yaşayabilirsiniz. Bu sebeple alternatif makrolu çözümü de veriyorum. Hız olarak daha sağlıklı sonuçlar üretecektir.

Takvim sayfasında tarihleriniz "CH" sütununda bitiyordu. Bu sebeple kodu o sütuna göre ayarladım. Alanınız daha genişse kod içindeki aşağıdaki satıra müdahale etmeniz gerekiyor.

S2.Range("A2:CH" & S2.Rows.Count).ClearContents

Kod: 
Option Explicit

Sub Takvime_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Personel()
    Dim X As Long, Son As Long, Liste As Object, Zaman As Double
    Dim Tarih_Bul As Range, Personel_Bul As Range, Y As Date
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("LISTE")
    Set S2 = Sheets("TAKVIM")
    
    S2.Range("A2:CH" & S2.Rows.Count).ClearContents
    
    Son = S1.Cells(S1.Rows.Count, 3).End(3).Row
    Personel = S1.Range("C2:C" & Son).Value
    
    Set Liste = CreateObject("Scripting.Dictionary")
    
    For X = 1 To UBound(Personel)
        Liste(Personel(X, 1)) = 1
    Next
    
    S2.Range("A2:A" & Liste.Count + 1) = Application.Transpose(Liste.Keys)
    
    For X = 2 To Son
        For Y = S1.Cells(X, 4) To S1.Cells(X, 5)
            Set Tarih_Bul = S2.Rows(1).Find(Y)
            If Not Tarih_Bul Is Nothing Then
                Set Personel_Bul = S2.Columns(1).Find(S1.Cells(X, 3), , , xlWhole)
                If Not Personel_Bul Is Nothing Then
                    If S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = "" Then
                        S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = "* " & S1.Cells(X, 1) & " " & S1.Cells(X, 2)
                    Else
                        S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) & Chr(10) & _
                                                                       "* " & S1.Cells(X, 1) & " " & S1.Cells(X, 2)
                    End If
                End If
            End If
        Next
    Next

    Application.ScreenUpdating = True
    
    Set Tarih_Bul = Nothing
    Set Personel_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set Liste = Nothing
    
    MsgBox "Verileriniz takvime aktarılmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhaba,

Hocam çok teşekkür ederim konu ile ilgili yardımlarınızı için.
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Hocam Makroyu uyguladığınız dosyayı paylaşma imkanınız varmı?
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Sayın Hocam merhabalar,

Daha önce yardımlarınızla oluşturduğumuz tabloda yeni sütunlar eklemek durumda kaldım ve formüldeki değişimi düzeltemedim. Ekteki tabloda WORK LIST sayfasındaki PERSONEL ( L ) in karşısında olan LOCATION ( D ) alanıyla PRODUCT NAME ( E ) birleştirerek, STARTED ON ( N ) ve ESTIMATED WORK ( O ) tarihlerine göre CALENDER sayfasına listeleyen bir tabloyu yeniden oluşturmamda yardımınızı rica ediyorum.
 

Ekli dosyalar

Son düzenleme:
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhabalar, konu günceldir.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

DİZİ formüldür.

B2;
Kod: 
=EĞERHATA("* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));1);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));1);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));2);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));2);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));3);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));3);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));4);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));4);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));5);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$C$1:$C$1000))));5);5);"")
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhaba,

Dizi formülü denedim fakat bazı alanlarda atlama yaptı CALENDER sayfasında kırmızı dolgulu alanda olduğu gibi. Formülde personel alanı olması gereken yeri değiştirdim son kod satırım aşağıdadır.

Kod: 
=EĞERHATA("* "&İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$D$1:$D$974))));1);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$C$1:$C$974))));1);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$D$1:$D$974))));2);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$K$1:$K$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$C$1:$C$974))));2);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$D$1:$D$974))));3);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$C$1:$C$974))));3);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$D$1:$D$974))));4);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$C$1:$C$974))));4);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$D$1:$D$974))));5);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$974;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$974=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$974;EĞER(B$1<='WORK LIST'!$O$1:$O$974;SATIR('WORK LIST'!$C$1:$C$974))));5);5);"")
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Formül uzun olduğu için sanırım gözünüzden kaçtı.

Formülün ikinci satırında "L" sütununa başvurması gereken bir alan "K" sütunu olarak görünüyor. Bunu düzeltirseniz sorun düzelecektir.

Bulamazsanız aşağıdaki formülü kullanabilirsiniz.

Kod: 
=EĞERHATA("* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$D$1:$D$1000))));1);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$E$1:$E$1000))));1);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$D$1:$D$1000))));2);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$E$1:$E$1000))));2);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$D$1:$D$1000))));3);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$E$1:$E$1000))));3);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$D$1:$D$1000))));4);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$E$1:$E$1000))));4);5);"")&
EĞERHATA(DAMGA(10)&"* "&İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$D$1:$D$1000))));5);4);"")&" "&EĞERHATA(İNDİS('WORK LIST'!$A$1:$S$1000;KÜÇÜK(EĞER('WORK LIST'!$L$1:$L$1000=$A2;EĞER(B$1>='WORK LIST'!$N$1:$N$1000;EĞER(B$1<='WORK LIST'!$O$1:$O$1000;SATIR('WORK LIST'!$E$1:$E$1000))));5);5);"")
 
I

istanbluend

Altın Üye
Katılım
4 Aralık 2019
Mesajlar
11
Excel Vers. ve Dili
2013 (TR)
Altın Üyelik Bitiş Tarihi
03-11-2024
Merhaba Hocam,

Kod istediğim gibi çalışıyor emeğinize sağlık.
 
M

msozturk07

Katılım
4 Şubat 2020
Mesajlar
3
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
04-02-2021
Korhan Ayhan' Alıntı:
Tekrar Merhaba,

Verileriniz çoğaldığında formüller sonucunda yavaşlama yaşayabilirsiniz. Bu sebeple alternatif makrolu çözümü de veriyorum. Hız olarak daha sağlıklı sonuçlar üretecektir.

Takvim sayfasında tarihleriniz "CH" sütununda bitiyordu. Bu sebeple kodu o sütuna göre ayarladım. Alanınız daha genişse kod içindeki aşağıdaki satıra müdahale etmeniz gerekiyor.

S2.Range("A2:CH" & S2.Rows.Count).ClearContents

Kod: 
Option Explicit

Sub Takvime_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Personel()
    Dim X As Long, Son As Long, Liste As Object, Zaman As Double
    Dim Tarih_Bul As Range, Personel_Bul As Range, Y As Date
  
    Zaman = Timer
  
    Application.ScreenUpdating = False
  
    Set S1 = Sheets("LISTE")
    Set S2 = Sheets("TAKVIM")
  
    S2.Range("A2:CH" & S2.Rows.Count).ClearContents
  
    Son = S1.Cells(S1.Rows.Count, 3).End(3).Row
    Personel = S1.Range("C2:C" & Son).Value
  
    Set Liste = CreateObject("Scripting.Dictionary")
  
    For X = 1 To UBound(Personel)
        Liste(Personel(X, 1)) = 1
    Next
  
    S2.Range("A2:A" & Liste.Count + 1) = Application.Transpose(Liste.Keys)
  
    For X = 2 To Son
        For Y = S1.Cells(X, 4) To S1.Cells(X, 5)
            Set Tarih_Bul = S2.Rows(1).Find(Y)
            If Not Tarih_Bul Is Nothing Then
                Set Personel_Bul = S2.Columns(1).Find(S1.Cells(X, 3), , , xlWhole)
                If Not Personel_Bul Is Nothing Then
                    If S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = "" Then
                        S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = "* " & S1.Cells(X, 1) & " " & S1.Cells(X, 2)
                    Else
                        S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) = S2.Cells(Personel_Bul.Row, Tarih_Bul.Column) & Chr(10) & _
                                                                       "* " & S1.Cells(X, 1) & " " & S1.Cells(X, 2)
                    End If
                End If
            End If
        Next
    Next

    Application.ScreenUpdating = True
  
    Set Tarih_Bul = Nothing
    Set Personel_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set Liste = Nothing
  
    MsgBox "Verileriniz takvime aktarılmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...

Hocam merhaba, bu makroyla tablomuzdaki verileri takvimimize günlük olarak işleyebiliyoruz ama tabiiki de tüm verileri takvimde göstermek tablonun okunurluğunu sıkıntıya sokacağı için tabloya işlemiyoruz. Peki ya biz o gün yapılan işle ilgili tüm bilgilere ulaşmak istersek? Takvimde yer alan bilgiye tıklayarak o bilginin tabloda sahip olduğu tüm değerlere ulaşabileceğimiz bir makro yazılabilir mi?

İkinci olarak da tabloda yer alan tüm olayları takvime yansıtmak istemiyoruz diyelim. Yani olaylardan sadece gerçekleşenleri takvime yansıtmak istiyoruz ama gerçekleşmeyip yine de tabloda duran olayları takvime yansıtmak istemiyoruz. Bunu nasıl yapabiliriz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst