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.
Özet Tablo (çoklueğersay)
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.
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
(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...
Rica ederim.
getir "Ýptal", 4, i burdaki iptaldaki i yi büyük yapın.
getir "Ýptal", 4, i burdaki iptaldaki i yi büyük yapın.
Konuyu Okuyanlar: 1 Ziyaretçi