Özet tablo

[mesudiye_052]

Selamlar;


Aşağıda belirttiğim işlem özet tablo olarak yapılabilir mi

Not: Sniz puantaj tablosunda Senelik izin anlamındadır.


















A Sütunu.........B Sütunu........C Sütunu......D Sütunu.......E Sütunu.......F Sütunu........G Sütun........H sutunu
Ad-Soyad........01.01.2017...02.01.2017..03.01.2017..04.01.2017..05.01.2017...06.01.2017.........07.01.2017
Ali .......................Sniz............Sniz................................Sniz..............Sniz
Sedat...................................Sniz...........Sniz.................Sniz.................................Sniz
vb....


Özet tabloda olmasını istediğim
Ad-Soyad.......Başlangıç tarih..Bitiş tarih
Ali.................01.01.2017......03.01.2017
Ali.................04.01.2017......06.01.2017
Sedat............02.01.2017......05.01.2017
Sedat............06.01.2017......07.01.2017

Saygılarla;

 

[mesudiye_052]

Selamlar;

Özet tablo ile olmuyorsa makro ile başka sayfaya aktarılarak yapılabilir mi

Saygılarla;

 

[cems]

Bu kadar yazmaya uğraşmaktansa örnek bir dosya yükleseydiniz daha çabuk cevap alırdınız. Siteye üye değilseniz www.dosya.tc gibi bir dış servera da yukleyip linkini burada paylaşabilirsiniz

 

[mesudiye_052]

Selamlar

dosya ektedir


http://s6.dosya.tc/server8/eapia0/DENEME_EXCEL.xlsx.html

 

[mesudiye_052]

Selamlar;

Özet tablo ile olmuyorsa makro ile de olabilir.

Yardımcı olursanız sevinirim

Saygılarla;

 

[mesudiye_052]

Selamlar;


Eklediğim excel dosyasında olmasını istediğim özet tablo kısmından işe başlamada 07.02.2017 olan
07.01.2017 olacak yanlış yazmışım

Saygılarla;

 

[mesudiye_052]

Selamlar;
Yardımcı olursanız sevinirim.

 

[mesudiye_052]

Selamlar;

Eklediğim excel dosyasında olmasını istediğim özet tablo kısmından işe başlamada 07.02.2017 olan tarih
07.01.2017 olacak yanlış yazmışım

Örnek dosya 4.mesajdadır

yapılırsa çok işime yarayacak

şimdiden teşekkür ederim

Saygılarla;

 

[mesudiye_052]

selamlar
yardımcı olursanız sevinirim

Saygılarımla

 

[mesudiye_052]

Selamlar;

Yenilenmiş dosyayı tekrar yükledim
yardımcı olursanız sevinirim



http://s6.dosya.tc/server8/3ciodp/DENEME_EXCEL.xlsx.html

 

[Korhan Ayhan]

Makro ile hazırlamak daha kolay olacak gibi görünüyor...

 

[mesudiye_052]

Selamlar;

Korhan bey

Makro ile olursa çok sevinirim

Saygılarımla

 

[mesudiye_052]

Selamlar
Makro ile yapılırsa sevinirim

Saygılarla;

 

[mesudiye_052]

Selamlar;

Makro ile yapılırsa çok memnun olacağım

Saygılarımla;

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub İZİNLERİ_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Y As Integer
    Dim Veri As String, Z As Integer, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    S2.Range("A1:D" & Rows.Count).Clear
    S2.Range("A1:D1") = Array("ADI", "SOYADI", "İZİN BAŞLANGIÇ", "İŞE BAŞLAMA")
    S2.Range("A1:D1").Font.Bold = True
    S2.Range("A1:D1").Font.ColorIndex = 3
    S2.Range("A1:D1").HorizontalAlignment = xlCenter
    Son = S1.Cells(Rows.Count, 2).End(3).Row
    Satir = 2
    
    For X = 2 To Son
        If S1.Cells(X, 2) <> "" Then
            S2.Cells(Satir, 1) = S1.Cells(X, 2)
            S2.Cells(Satir, 2) = S1.Cells(X, 3)
            For Y = 8 To S1.Cells(1, Columns.Count).End(1).Column
                Veri = UCase(Replace(Replace(S1.Cells(X, Y), "ı", "I"), "i", "İ"))
                If Veri = "SNİZ" Then
                    If S2.Cells(Satir, 1) = "" Then
                        S2.Cells(Satir, 1) = S1.Cells(X, 2)
                        S2.Cells(Satir, 2) = S1.Cells(X, 3)
                    End If
                    S2.Cells(Satir, 3) = CDate(S1.Cells(1, Y))
                    For Z = Y + 1 To S1.Cells(1, Columns.Count).End(1).Column
                        Veri = UCase(Replace(Replace(S1.Cells(X, Z), "ı", "I"), "i", "İ"))
                        If Veri = "" Then
                            S2.Cells(Satir, 4) = CDate(S1.Cells(1, Z))
                            Satir = Satir + 1
                            Y = Z - 1
                            Exit For
                        End If
                    Next
                End If
            Next
        End If
    Next

    S2.Cells.EntireColumn.AutoFit

    Set S1 = Nothing
    Set S2 = Nothing

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[mesudiye_052]

Selamlar;
Sayın Korhan bey

çok çok teşekkür ederim.