DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sat As Long, k As Range, adr As String, deg As String, i As Long
If Intersect(Target, Range("D4")) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
If Target.Value = Range("H2").Value Then
deg = "*"
Else
deg = Target.Value
End If
sat = 9
Range("B9:F65536").ClearContents
Set k = Range("L9:L" & Cells(65536, "L").End(xlUp).Row).Find(deg, , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
Cells(sat, "F").Value = Cells(k.Row, "O").Value
Range("C" & sat & ":E" & sat).Value = Range("L" & k.Row & ":N" & k.Row).Value
sat = sat + 1
Set k = Range("L9:L" & Cells(65536, "L").End(xlUp).Row).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
Range("C9:F65536").Sort Range("F9")
For i = 9 To Cells(65536, "C").End(xlUp).Row
Cells(i, "B").Value = i - 8
Next i
End If
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır."
End Sub
Rica ederim.evren bey
tam istediğim gibi oldu ellerinize sağlık
çok teşekkürler
Düzelltim.evren bey
birşey dikkatimi çekti
tüm personel süzmesini yaparken
üretim ali doğan inşaat mühendisi
satırı 31. satıra gidiyor halbuki ilk 6 satır içinde olmalı
bu durumu nasıl düzeltebiliriz
iyi çalışmalar
Durumu düzelltim.evren bey
zahmet olmaz ise
bu seferde tüm takımlar seçiminde
oluşmaması gereken bir satır oluşuyor
bunu nasıl düzeltebiliriz.
(32. satır olarakTAKIM PERSONEL MESLEK)