AccessTr.neT
Özet Tablo (çoklueğersay) - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Özet Tablo (çoklueğersay) (/konu-ozet-tablo-cokluegersay.html)

Sayfalar: 1 2 3 4 5

Özet Tablo (çoklueğersay) - cdenktas - 08/12/2023

Değerli arkadaşlar;

Kayıt No: T-01 tek bir dosya olup içerisinde üç farklı firma yer almaktadır. Dosya bedeli tektir (Her firmanın ihale bedeli yoktur.)

Benim yapmak istediğim özet tablo sayfasına ilgili personellerin iş tabiki kontrol etmek (Excel Paylaşımlı ortak bir klasörde yer almaktadır)


Özet Tabloda "Bitti" (B2 hücresine) kısmına ilgili personelin biten iş sayılarını getirmek isitoryorum. Ancak Kayıt No aynı olan tüm firmalar bitti olduğunda (x, y, z firmaların hepsi bitti olduğunda) ilgili personelin b2 hücresine sadece 1 adet dosya bittini göstermek, eğersay yaptığımda 3 firma var 3 bitti oluyor özet tabloya 3 getiriyor sadece 1 adet olması gerekir.

c hücresine aynı kayıt no'dan bir firma devam etse bile ilgili personelin özet tablosuna 1 getirmesi olayı;

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

RE: Özet Tablo (çoklueğersay) - feraz - 09/12/2023

Sayfaya bir adet activex commandbutton yani buton ekleyip kodu yapıştırıp çalıştırın.
Private Sub CommandButton1_Click() yada burayı makro yapıp çalıştırın sub test() gibi.


Kod:
Sub getir(ByVal deger As String, ByVal alan As Integer, ByVal i As Integer)

    Dim dic As Object, son As Long, say As Long, ii As Long, key As String
    say = 0
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Özet Tablo")
        son = Worksheets(.Cells(i, 1).Value).Range("A" & Rows.Count).End(3).Row
        If son < 2 Then GoTo sonSub
        For ii = 2 To son
            If ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("H" & ii).Value = deger Then
                key = ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("B" & ii).Value & deger
                If Not dic.Exists(key) Then
                    dic.Add key, say
                    say = say + 1
                End If
            End If
        Next
        .Cells(i, alan).Value = say
    End With
sonSub:
    Set dic = Nothing
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long
    With ThisWorkbook.Worksheets("Özet Tablo")
        .Range("B2:D" & .Cells(Rows.Count, "A").End(3).Row + 1).ClearContents
        For i = 2 To .Range("A" & Rows.Count).End(3).Row
            getir "Bitti", 2, i
            getir "Devam Ediyor", 3, i
            getir "Ýptal", 4, i
        Next
    End With
End Sub


RE: Özet Tablo (çoklueğersay) - cdenktas - 11/12/2023

(09/12/2023, 01:08)feraz yazdı: Sayfaya bir adet activex commandbutton yani buton ekleyip kodu yapıştırıp çalıştırın.
Private Sub CommandButton1_Click() yada burayı makro yapıp çalıştırın sub test() gibi.


Kod:
Sub getir(ByVal deger As String, ByVal alan As Integer, ByVal i As Integer)

    Dim dic As Object, son As Long, say As Long, ii As Long, key As String
    say = 0
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Özet Tablo")
        son = Worksheets(.Cells(i, 1).Value).Range("A" & Rows.Count).End(3).Row
        If son < 2 Then GoTo sonSub
        For ii = 2 To son
            If ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("H" & ii).Value = deger Then
                key = ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("B" & ii).Value & deger
                If Not dic.Exists(key) Then
                    dic.Add key, say
                    say = say + 1
                End If
            End If
        Next
        .Cells(i, alan).Value = say
    End With
sonSub:
    Set dic = Nothing
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long
    With ThisWorkbook.Worksheets("Özet Tablo")
        .Range("B2:D" & .Cells(Rows.Count, "A").End(3).Row + 1).ClearContents
        For i = 2 To .Range("A" & Rows.Count).End(3).Row
            getir "Bitti", 2, i
            getir "Devam Ediyor", 3, i
            getir "Ýptal", 4, i
        Next
    End With
End Sub

Ellerinize sağlık Özge kısmında 1 adet iptal gelmiyor, birde T-01 işi tam bitmediğimde bitten iş yok devam eden 1 adet olması gerekiyor...

RE: Özet Tablo (çoklueğersay) - feraz - 11/12/2023

Rica ederim.
getir "Ýptal", 4, i burdaki  iptaldaki i yi büyük yapın.

RE: Özet Tablo (çoklueğersay) - cdenktas - 11/12/2023

(11/12/2023, 11:54)feraz yazdı: Rica ederim.
getir "Ýptal", 4, i burdaki  iptaldaki i yi büyük yapın.

Özge Sayfasındaki Kayıt No : T-01 tüm işler bitmediğinden ÖÖzet Tabloda Özge Biten iş "0" devam eden "1" olması gerekiyor.

RE: Özet Tablo (çoklueğersay) - feraz - 11/12/2023

(11/12/2023, 13:30)cdenktas yazdı:
(11/12/2023, 11:54)feraz yazdı: Rica ederim.
getir "Ýptal", 4, i burdaki  iptaldaki i yi büyük yapın.

Özge Sayfasındaki Kayıt No : T-01 tüm işler bitmediğinden ÖÖzet Tabloda Özge Biten iş "0" devam eden "1" olması gerekiyor.

Bakacağım sonra ama bulmaca gibi soru.