• DİKKAT

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

Excel'de 2 haftalik ozet cikartmak

E

edi1900

Katılım
7 Haziran 2010
Mesajlar
5
Excel Vers. ve Dili
2000
Merhaba,

Benim Excel'de makro ile ilgili bir sorum var. Ekledigim ornekte detayli olarak sorumu anlatmaya calistim..

Yardimlariniz icin simdiden cok ama cok tesekkur ederim.
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, KONTROL As Boolean
    Dim X As Byte, Y As Byte, SATIR As Long, BUL As Range, ADRES As String
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    SATIR = 1
    S2.Range("A:D").Clear
    
    S2.Select
    
    For X = 2 To S1.Range("IV2").End(1).Column
        Set BUL = S1.Range("A3:IV3").Find(S1.Cells(3, X))
        If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Cells(3, BUL.Column)) = 0 Then
            If Not BUL Is Nothing Then
                ADRES = BUL.Address
                Do
                    If KONTROL = True Then
                        SATIR = S2.Cells(65536, 3).End(3).Row + 1
                        S2.Cells(SATIR, 3) = S1.Cells(2, BUL.Column) & "/" & S1.Cells(4, BUL.Column)
                    Else
                        S2.Cells(SATIR, 1) = "Sorumlu"
                        S2.Cells(SATIR, 2) = S1.Cells(3, BUL.Column)
                        S2.Cells(SATIR + 1, 2) = "Dosya Adı"
                        S2.Cells(SATIR + 1, 3) = S1.Cells(2, BUL.Column) & "/" & S1.Cells(4, BUL.Column)
                    End If
                        For Y = 6 To S1.Cells(65536, BUL.Column).End(3).Row
                            If IsDate(S1.Cells(Y, BUL.Column)) Then
                                SATIR = S2.Cells(65536, 3).End(3).Row + 1
                                If S1.Cells(Y, BUL.Column) < Date Then
                                    S2.Cells(SATIR, 3) = S1.Cells(Y, 1)
                                    S2.Cells(SATIR, 4) = Format(S1.Cells(Y, BUL.Column), "dd.mm.yyyy")
                                    S2.Cells(SATIR, 4).Interior.ColorIndex = 3
                                ElseIf S1.Cells(Y, BUL.Column) >= Date And S1.Cells(Y, BUL.Column) <= (Date + 14) Then
                                    S2.Cells(SATIR, 3) = S1.Cells(Y, 1)
                                    S2.Cells(SATIR, 4) = Format(S1.Cells(Y, BUL.Column), "dd.mm.yyyy")
                                    S2.Cells(SATIR, 4).Interior.ColorIndex = 6
                                End If
                            End If
                        Next
            Set BUL = S1.Range("A3:IV3").FindNext(BUL)
            KONTROL = True
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
        
        KONTROL = False
        SATIR = S2.Cells(65536, 3).End(3).Row + 2
    Next
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, KONTROL As Boolean
    Dim X As Byte, Y As Byte, SATIR As Long, BUL As Range, ADRES As String
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    SATIR = 1
    S2.Range("A:D").Clear
    
    S2.Select
    
    For X = 2 To S1.Range("IV2").End(1).Column
        Set BUL = S1.Range("A3:IV3").Find(S1.Cells(3, X))
        If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Cells(3, BUL.Column)) = 0 Then
            If Not BUL Is Nothing Then
                ADRES = BUL.Address
                Do
                    If KONTROL = True Then
                        SATIR = S2.Cells(65536, 3).End(3).Row + 1
                        S2.Cells(SATIR, 3) = S1.Cells(2, BUL.Column) & "/" & S1.Cells(4, BUL.Column)
                    Else
                        S2.Cells(SATIR, 1) = "Sorumlu"
                        S2.Cells(SATIR, 2) = S1.Cells(3, BUL.Column)
                        S2.Cells(SATIR + 1, 2) = "Dosya Adı"
                        S2.Cells(SATIR + 1, 3) = S1.Cells(2, BUL.Column) & "/" & S1.Cells(4, BUL.Column)
                    End If
                        For Y = 6 To S1.Cells(65536, BUL.Column).End(3).Row
                            If IsDate(S1.Cells(Y, BUL.Column)) Then
                                SATIR = S2.Cells(65536, 3).End(3).Row + 1
                                If S1.Cells(Y, BUL.Column) < Date Then
                                    S2.Cells(SATIR, 3) = S1.Cells(Y, 1)
                                    S2.Cells(SATIR, 4) = Format(S1.Cells(Y, BUL.Column), "dd.mm.yyyy")
                                    S2.Cells(SATIR, 4).Interior.ColorIndex = 3
                                ElseIf S1.Cells(Y, BUL.Column) >= Date And S1.Cells(Y, BUL.Column) <= (Date + 14) Then
                                    S2.Cells(SATIR, 3) = S1.Cells(Y, 1)
                                    S2.Cells(SATIR, 4) = Format(S1.Cells(Y, BUL.Column), "dd.mm.yyyy")
                                    S2.Cells(SATIR, 4).Interior.ColorIndex = 6
                                End If
                            End If
                        Next
            Set BUL = S1.Range("A3:IV3").FindNext(BUL)
            KONTROL = True
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
        End If
        
        KONTROL = False
        SATIR = S2.Cells(65536, 3).End(3).Row + 2
    Next
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Cok tesekkur ederim.

Gec cevap yazdim kusura bakma. Cok tesekkur ederim, cok iyi calisiyor ama bazen soyle bir sorun oluyor;

1. Ornegin Ahmet Can'in iki tane farkli sorumlulugu varya; Ahmet Can'i iki kere yazdiriyor;

Ahmet Can (Adana/Ceyhan, Izmir/Konak) Sibel Kas (Ankara/Cankaya), Mert Yol (Istanbul/Bakirkoy) Ahmet Can (Adana/Ceyhan, Izmir/Konak)

Yani Ahmet Can'i bir Adana/Ceyhan'in orada yazdiriyor (Izmir/Konak'ida ekliyor listeye, birde Izmir/Konak'a gelince (Adana Ceyhan'i da ekliyor)

2. Birde mesela bazi tarihleri hic gostermeme gibi birseyi nasil yapabiliriz? Ornegin Sorumluluk 6, Sorumluluk 8, Sorumluluk 9 hic gozukmesin bu islemde. Yapilabilir mi yani o satirlar aramadan cikartila bilir mi?

3. Bu ornekte Sayfa 1 ve Sayfa 2 vardi, ana data Sayfa 1 de idi, biz Sayfa 2 ye istedigimiz bilgileri Sayfa 1 den alip yazdiriyoruz. Peki Sayfa 1 gibi Sayfa 3'te data olsa (sayfa 3 sayfa 1 le ayni yapida isimlerde ayni) Bu makro Sayfa 3 le Sayfa 1 i arayip onu Sayfa 2' ye yapistirabilir mi? Birde kisiye gore filtre uygulanabilir mi? Mesela acilan listeden bir isim secsek ve o kisinin Sayfa 1 ve Sayfa 3'te ki tum sorumluluklarini (oncekiler ve 2 hafta sonrakiler) gorebilir miyiz?


Cok soru sordum. Simdiden cok ama cok tesekkur ederim.
 
edi1900' Alıntı:
Cok tesekkur ederim.

Gec cevap yazdim kusura bakma. Cok tesekkur ederim, cok iyi calisiyor ama bazen soyle bir sorun oluyor;

1. Ornegin Ahmet Can'in iki tane farkli sorumlulugu varya; Ahmet Can'i iki kere yazdiriyor;

Ahmet Can (Adana/Ceyhan, Izmir/Konak) Sibel Kas (Ankara/Cankaya), Mert Yol (Istanbul/Bakirkoy) Ahmet Can (Adana/Ceyhan, Izmir/Konak)

Yani Ahmet Can'i bir Adana/Ceyhan'in orada yazdiriyor (Izmir/Konak'ida ekliyor listeye, birde Izmir/Konak'a gelince (Adana Ceyhan'i da ekliyor)

Bunun sebebini buldum. Sunu S2.Cells(SATIR, 2) = S1.Cells(5, BUL.Column) sununla degistirdigim zaman sorun cikiyor, eger orjinal halini tutarsam bi sorun yok ama ben onun ilk sutuna yazilmasini istiyorum. Nasil yapabilirim?

2. Birde mesela bazi tarihleri hic gostermeme gibi birseyi nasil yapabiliriz? Ornegin Sorumluluk 6, Sorumluluk 8, Sorumluluk 9 hic gozukmesin bu islemde. Yapilabilir mi yani o satirlar aramadan cikartila bilir mi?

3. Bu ornekte Sayfa 1 ve Sayfa 2 vardi, ana data Sayfa 1 de idi, biz Sayfa 2 ye istedigimiz bilgileri Sayfa 1 den alip yazdiriyoruz. Peki Sayfa 1 gibi Sayfa 3'te data olsa (sayfa 3 sayfa 1 le ayni yapida isimlerde ayni) Bu makro Sayfa 3 le Sayfa 1 i arayip onu Sayfa 2' ye yapistirabilir mi? Birde kisiye gore filtre uygulanabilir mi? Mesela acilan listeden bir isim secsek ve o kisinin Sayfa 1 ve Sayfa 3'te ki tum sorumluluklarini (oncekiler ve 2 hafta sonrakiler) gorebilir miyiz?


Cok soru sordum. Simdiden cok ama cok tesekkur ederim.
Genişletmek için tıkla ...


Birinci sorunun sebebini buldum, yukarida aciklamaya calistim. Tesekkurler.
 
edi1900' Alıntı:
Birinci sorunun sebebini buldum, yukarida aciklamaya calistim. Tesekkurler.
Genişletmek için tıkla ...

Merhaba tekrar,

Birinci ve ikinci sorunu cozdum, sadece sonuncu sorun var, acaba onu nasil yapabilirim?


3. Bu ornekte Sayfa 1 ve Sayfa 2 vardi, ana data Sayfa 1 de idi, biz Sayfa 2 ye istedigimiz bilgileri Sayfa 1 den alip yazdiriyoruz. Peki Sayfa 1 gibi Sayfa 3'te data olsa (sayfa 3 sayfa 1 le ayni yapida isimlerde ayni) Bu makro Sayfa 3 le Sayfa 1 i arayip onu Sayfa 2' ye yapistirabilir mi? Birde kisiye gore filtre uygulanabilir mi? Mesela acilan listeden bir isim secsek ve o kisinin Sayfa 1 ve Sayfa 3'te ki tum sorumluluklarini (oncekiler ve 2 hafta sonrakiler) gorebilir miyiz?

Tesekkurler.
 
edi1900' Alıntı:
Merhaba tekrar,

Birinci ve ikinci sorunu cozdum, sadece sonuncu sorun var, acaba onu nasil yapabilirim?


3. Bu ornekte Sayfa 1 ve Sayfa 2 vardi, ana data Sayfa 1 de idi, biz Sayfa 2 ye istedigimiz bilgileri Sayfa 1 den alip yazdiriyoruz. Peki Sayfa 1 gibi Sayfa 3'te data olsa (sayfa 3 sayfa 1 le ayni yapida isimlerde ayni) Bu makro Sayfa 3 le Sayfa 1 i arayip onu Sayfa 2' ye yapistirabilir mi? Birde kisiye gore filtre uygulanabilir mi? Mesela acilan listeden bir isim secsek ve o kisinin Sayfa 1 ve Sayfa 3'te ki tum sorumluluklarini (oncekiler ve 2 hafta sonrakiler) gorebilir miyiz?

Tesekkurler.
Genişletmek için tıkla ...

OK, bu sorunuda cozdum. Konu kapanabilir. Tesekkurler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst