DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[B]Private Sub TextBox[COLOR="red"]6[/COLOR]_Change()[/B]
On Error Resume Next
a = TextBox[B][COLOR="red"]6[/COLOR][/B].Value
Range("A5:D" & [D65536].End(3).Row).AutoFilter Field:=4, Criteria1:="*" & TextBox[B][COLOR="red"]6[/COLOR][/B].Value & "*"
If a = "" Then
Selection.AutoFilter Field:=4
End If
[B]End Sub[/B][SIZE="1"]
[/SIZE][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
Dim y As Worksheet: Set y = Sheets("YAZI")
TextBox[B][COLOR="red"]6[/COLOR][/B] = ""
Call LİSTELE
[B]End Sub[/B]
Private Sub ComboBox1_Change()
Dim l As Worksheet: Set l = Sheets("LİSTE")
Dim y As Worksheet: Set y = Sheets("YAZI")
sony = y.[D65536].End(3).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If OptionButton2 = True And ActiveCell.Column < 4 Then Exit Sub
If ComboBox1.ListIndex = 0 Then
y.Range("D6:D" & sony) = ""
y.Cells(5, 4) = "YETKİ LİSTESİ"
Exit Sub
End If
y.Range("D6:D" & sony) = ""
y.Cells(5, 4) = "YETKİ LİSTESİ"
On Error Resume Next
a = WorksheetFunction.Match(l.Cells(ComboBox1.ListIndex + 1, 1), l.Range("1:1"), 0)
sonl = l.Cells(65536, a).End(3).Row
For k = 2 To sonl
Cells(k + 4, 4) = l.Cells(k, a)
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
y.Range("A6:D300").ClearContents
y.Range("A6:D300").ClearComments
y.Cells(5, 1) = "TALEP EDİLEN YETKİLER"
y.Cells(5, 4) = "YETKİ LİSTESİ"
OptionButton2 = True
y.Cells(3, 7) = 2
y.Cells(4, 4).Activate
Selection.AutoFilter Field:=4
TextBox6 = ""
Selection.AutoFilter Field:=4