Soru Sayfalardan koşula bağlı veri çekme

[Ceolwsy]

Merhabalar herkese kolay gelsin. Yazmaya çalıştığım makro kodu ile alakalı ufak bir yardıma ihtiyacım var yardımlarınız için şimdiden teşekkür ederim.

Rapor sayfasında statüsü %100 olan işlemlerin yapıldığı tarihi özet sayfasındaki tabloya buton yardımıyla eklemek istiyorum. Tablonun satırı ve sütununda 2 ayrı durum mevcut. Statüsü %100 olan işlemlerin tarihini bu 2 durumun kesiştiği hücreye yazdırmak istiyorum.

https://r.resimlink.com/fvsezQL.jpeg tarihleri çekmek istediğim olayların statü durumları bu şekilde // 2 durum var wtg numarası ve kategori

https://r.resimlink.com/WYLdZs.jpeg tarihleri eklemek istediğim tablo burası

Teşekkürler

 

[Ömer]

Merhaba,

Yapmak istediklerinizi küçük bir Excel örnek dosyası ekleyerek dosya içerisinde detaylı açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

.

 

[Ceolwsy]

Merhabalar dosyayı eklemeye çalıştım linki iletiyorum. Rapor sayfasından 30 tane olacak aylık şekilde düşünebiliriz. Tek sayfasını ekledim tarihleri özet tablosuna çekmek istiyorum

İndir denemesayfa

Dosyayı indir denemesayfa

dosya.co

 

[Ömer]

Formülü denemeniz ve konuyu anlamam için veriyorum.

Özet sayfası B3 hücresine yazıp alt satırlara kopyalayın.
İstediğiniz bu sonuçların makro ile hazırlanması mı?

=EĞER(ÇOKETOPLA(rapor!A:A;rapor!H:H;100%;rapor!D:D;A3)=0;"";ÇOKETOPLA(rapor!A:A;rapor!H:H;100%;rapor!D:D;A3))

 

[Ceolwsy]

Evet bu formül ile veren sonucu tüm rapor sayfalarında uygulamak istiyorum ve ekleyeceğim butona tıklayınca tarihe göre tüm raporlardan çekmesini istiyorum

 

[Ceolwsy]

Evet bu formül ile veren sonucu tüm rapor sayfalarında uygulamak istiyorum ve ekleyeceğim butona tıklayınca tarihe göre tüm raporlardan çekmesini istiyorum

Fakat burda bir kısıt daha var wtg numarası yani wtg numarasına bağlı kategorileri filtrelemem gerekiyor

 

[Ömer]

*Özet sayfasında sadece %100 olan sütuna mı veri gelecek?
*Özet sayfasındaki B2 hücresi koşula ekleniyor mu. Ben formülde eklememiştim. B2 yi yeni farkettim.
*Aynı şekilde özet sayfasındaki C2, D2...H2 kadar olan şartlar ve yüzdeler kısmı boş mu kalacak?
*Tüm rapor sayfalarından kastınız nedir. İlk resimdeki 01 ile 20 arası sayfalar mı? Eğer öyleyse sayfa adlarını kodlara tanımlamak için belirtici bir özellik yazmalısınız. 01-20 arası gibi. Yada farklı bir belirtici durum.
*Tarihe göre demişsiniz. Bu kısmı anlayamadım. rapor sayfalarında, diyelim ki 3 farklı rapor sayfasında şarta uyan ve aynı hücreye denk gelen veri var. Örneğin 3 farklı rapor sayfasında "Stair at Bottom Section" değeri %100 ve wtg numarası aynı. Bu durumda ne olması gerekiyor.

Sorunuzla ilgili birçok havada kalan bölüm var. Şimdilik dikkatimi çekenler bunlar.

 

[Ceolwsy]

*Özet sayfasında sadece %100 olan sütuna mı veri gelecek?
*Özet sayfasındaki B2 hücresi koşula ekleniyor mu. Ben formülde eklememiştim. B2 yi yeni farkettim.
*Aynı şekilde özet sayfasındaki C2, D2...H2 kadar olan şartlar ve yüzdeler kısmı boş mu kalacak?
*Tüm rapor sayfalarından kastınız nedir. İlk resimdeki 01 ile 20 arası sayfalar mı? Eğer öyleyse sayfa adlarını kodlara tanımlamak için belirtici bir özellik yazmalısınız. 01-20 arası gibi. Yada farklı bir belirtici durum.
*Tarihe göre demişsiniz. Bu kısmı anlayamadım. rapor sayfalarında, diyelim ki 3 farklı rapor sayfasında şarta uyan ve aynı hücreye denk gelen veri var. Örneğin 3 farklı rapor sayfasında "Stair at Bottom Section" değeri %100 ve wtg numarası aynı. Bu durumda ne olması gerekiyor.

Sorunuzla ilgili birçok havada kalan bölüm var. Şimdilik dikkatimi çekenler bunlar.

Özet sayfasında, sadece rapor sayfasında %100 olarak girilen wtg numaralarına bağlı işlerin yapıldığı tarihi yazdırmak istiyorum. WTG2 için botton section işlemi yüzde 100 yani o gün tamamlandıysa özet tablosunda wtg2 ve botton sectionun keşiştiği hücreye o tarihi yazdırmak istiyorum. İstenilen tek şart o işin %100 tamamlanmış olması tamamlanan iş zaten wtg numarasına göre tabloya tarihi atanacak.

Tüm rapor sayfası derken ben şu an bunu tek rapor için yapıyorum fakat makro ile beraber istediğim 30 tane aynı formatta rapor sayfası olacak ve günlük yapılan işler o rapor sayfalarına işlenecek ben makro ile tüm o 30 günlük yapılan işleri sırayla yapılan iş %100 ise yine wtg numarasına göre özet tablosuna tarihini yazdırmak istiyorum. Evet ilk fotoğrafta belirttiğim gibi 01-20 arası gibi fakat o isimleri o günün tarihi olarak yazmayı düşünüyoruz
Bu verileri doldururken dediğiniz gibi aynı wtg numaralı türbinde yapılan işi farklı tarihlerde %100 yazılma durumuna karşı eğer özet tablosunda hücre boş ise tarih ataması yapmasını isteyeceğim ve eğer hücre daha önce başka tarih doldu ise uyarı vermesini isteyeceğim böylelikle yanlış veri girişlerini tespit edebileceğim.

Evet dediğiniz gibi tam ifade edemedim nasıl bir şey olduğunu kusura bakmayın lütfen. Ben hatalı veri girişlerinin tespitini en sona saklamıştım şu an sadece WTG numarası ve kategori bazlı tamamlanan işlerin tarihini özet tablosuna aktarmak istiyorum dediğim gibi sonrasında bunu 30 sayfa için genişletmek istiyorum tek buton ile 30 günlük raporun tarihlerini tarih önceliğine göre özet tablosuna işlemek istiyorum.

 

[Ömer]

Eklediğiniz Excel dosyası için.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String
    
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
    
    Application.ScreenUpdating = False
    S1.Range("B3:B" & Rows.Count).ClearContents

    For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row

        Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If S2.Cells(c.Row, "H") = S1.[B1] Then
                    If S2.Cells(c.Row, "B") = S1.[B2] Then
                        S1.Cells(i, "B") = S2.Cells(c.Row, "A")
                        Exit Do
                    End If
                End If
                Set c = S2.[D:D].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    
    Next i
    
    S1.Select
    Application.ScreenUpdating = True

End Sub

 

[Ceolwsy]

Eklediğiniz Excel dosyası için.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String
   
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
   
    Application.ScreenUpdating = False
    S1.Range("B3:B" & Rows.Count).ClearContents

    For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row

        Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If S2.Cells(c.Row, "H") = S1.[B1] Then
                    If S2.Cells(c.Row, "B") = S1.[B2] Then
                        S1.Cells(i, "B") = S2.Cells(c.Row, "A")
                        Exit Do
                    End If
                End If
                Set c = S2.[D:D].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
   
    Next i
   
    S1.Select
    Application.ScreenUpdating = True

End Sub

Öncelikkle çok teşekkür ederim kod çok güzel çalışıyor fakat kod ile alakalı ufak bir sorum daha var lütfen kusura bakmayın çok rahatsız ettim sizleri. WTG01 için olan işler için kod tam istediğim gibi çalışıyor fakat ben rapor sayfasında WTG02 ye bir iş girdiğimde ve bunun statüsünü %100 yaptığımda onu WTG02 sütununda ki hücrelere girmiyor, yani ben o rapor sayfasına birden fazla WTG numarası girebildiğim durumlar için özet tabloda numaranın ait olduğu sütundaki hücreye atamasını sağlayacak şekilde nasıl yapabilirim.

 

[Ömer]

Deneyiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String, j As Byte
    
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
    
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
    
    For j = 2 To 8
        If S1.Cells(1, j) = 1 Then
            For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        
                Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        If S2.Cells(c.Row, "H") = 1 Then
                            If S2.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                S1.Cells(i, j) = S2.Cells(c.Row, "A")
                                Exit Do
                            End If
                        End If
                        Set c = S2.[D:D].FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            
            Next i
        End If
    Next j
    
    S1.Select
    Application.ScreenUpdating = True

End Sub

 

[Ceolwsy]

Deneyiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String, j As Byte
   
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
   
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
   
    For j = 2 To 8
        If S1.Cells(1, j) = 1 Then
            For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
       
                Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        If S2.Cells(c.Row, "H") = 1 Then
                            If S2.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                S1.Cells(i, j) = S2.Cells(c.Row, "A")
                                Exit Do
                            End If
                        End If
                        Set c = S2.[D:D].FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
           
            Next i
        End If
    Next j
   
    S1.Select
    Application.ScreenUpdating = True

End Sub

Emeğiniz için teşekkürler fakat yine olmadı ilk kod ile aynı sonucu veriyor. WTG02 için bir işi %100 yaptığımda WTG02 sütunundaki hücreleri doldurmuyor

 

[Ömer]

Aynı zamanda özet sayfası WTG02 nin yüzdesini de %100 yapmanız gerekmiyor mu? Ben o şekilde kurgulayarak yazmıştım.

 

[Ömer]

Eğer özet sayfası 1.satırın kodlara etkisi olmayacaksa aşağıdaki gibi deneyiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String, j As Byte
    
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
    
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
    
    For j = 2 To 8
        'If S1.Cells(1, j) = 1 Then
            For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        
                Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        If S2.Cells(c.Row, "H") = 1 Then
                            If S2.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                S1.Cells(i, j) = S2.Cells(c.Row, "A")
                                Exit Do
                            End If
                        End If
                        Set c = S2.[D:D].FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            
            Next i
        'End If
    Next j
    
    S1.Select
    Application.ScreenUpdating = True

End Sub

 

[Ceolwsy]

Aynı zamanda özet sayfası WTG02 nin yüzdesini de %100 yapmanız gerekmiyor mu? Ben o şekilde kurgulayarak yazmıştım.

Onu sonraki süreçte renklendirme için kullanacaktım onun herhangi bir etkisi yok görsel için sadece

 

[Ceolwsy]

Eğer özet sayfası 1.satırın kodlara etkisi olmayacaksa aşağıdaki gibi deneyiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Adr As String, j As Byte
   
    Set S1 = Sheets("özet")
    Set S2 = Sheets("rapor")
   
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
   
    For j = 2 To 8
        'If S1.Cells(1, j) = 1 Then
            For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
       
                Set c = S2.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        If S2.Cells(c.Row, "H") = 1 Then
                            If S2.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                S1.Cells(i, j) = S2.Cells(c.Row, "A")
                                Exit Do
                            End If
                        End If
                        Set c = S2.[D:D].FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
           
            Next i
        'End If
    Next j
   
    S1.Select
    Application.ScreenUpdating = True

End Sub

Kod çalışıyor çok teşekkür ederim emeğinize

 

[Ömer]

Rica ederim, iyi bayramlar.

 

[Ömer]

Çoklu sayfası için.
Not: Detaylı deneme yapmadım. Sayfa numaralarının ilk 2 karakteri 1 ile 31 arasında olan sayfalarda arama yapar.

Sub rapor_coklu()

    Dim S1 As Worksheet, syf As Worksheet, i As Long, c As Range, Adr As String, j As Byte
  
    Set S1 = Sheets("özet")
  
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
  
    For j = 2 To 8
        For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
          
            For Each syf In ThisWorkbook.Worksheets
                If Left(syf.Name, 2) > 0 And Left(syf.Name, 2) < 32 Then
  
                    Set c = syf.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            If syf.Cells(c.Row, "H") = 1 Then
                                If syf.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                    S1.Cells(i, j) = syf.Cells(c.Row, "A")
                                    Exit For
                                End If
                            End If
                            Set c = syf.[D:D].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                End If
            Next syf
              
        Next i
    Next j
  
    S1.Select
    Application.ScreenUpdating = True
  
End Sub

 

[Ceolwsy]

Çoklu sayfası için.
Not: Detaylı deneme yapmadım. Sayfa numaralarının ilk 2 karakteri 1 ile 31 arasında olan sayfalarda arama yapar.

Sub rapor_coklu()

    Dim S1 As Worksheet, syf As Worksheet, i As Long, c As Range, Adr As String, j As Byte
 
    Set S1 = Sheets("özet")
 
    Application.ScreenUpdating = False
    S1.Range("B3:H" & Rows.Count).ClearContents
 
    For j = 2 To 8
        For i = 3 To S1.Cells(Rows.Count, "A").End(xlUp).Row
         
            For Each syf In ThisWorkbook.Worksheets
                If Left(syf.Name, 2) > 0 And Left(syf.Name, 2) < 32 Then
 
                    Set c = syf.[D:D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            If syf.Cells(c.Row, "H") = 1 Then
                                If syf.Cells(c.Row, "B") = S1.Cells(2, j) Then
                                    S1.Cells(i, j) = syf.Cells(c.Row, "A")
                                    Exit For
                                End If
                            End If
                            Set c = syf.[D:D].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                End If
            Next syf
             
        Next i
    Next j
 
    S1.Select
    Application.ScreenUpdating = True
 
End Sub

Merhabalar teşekkür ederim öncelikle hayırlı bayramlar sizede. Kodlar çalışıyor çok teşekkürler If syf.Cells(c.Row, "H") = 1 Then burada aralık belirtmek istersem nasıl düzenleyebilirim yani ben direkt H29 ile H49 arası demek istiyorum. Raporumun orijinalinde size attığım tüm sütunlar 29 ile 49. satır arasında yer alıyor. Range ile yapmaya çalıştım fakat hata alıyorum

 

[Ömer]

Verilerin arandığı aralıktan mı bahsediyorsunuz.

Kodlarda;
Set c = syf.[D: D].Find(S1.Cells(i, "A"), , xlValues, xlWhole)
.
.
.
Set c = syf.[D: D].FindNext(c)

Yukarıda iki satırdaki [D: D] yerine [D29: D49] yazmanız yeterli olacaktır.

.