DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub kod_bir()
Application.ScreenUpdating = False
Dim sv As Worksheet
Dim sd As Worksheet
Set sv = Sheets("veri")
Set sd = Sheets("data")
aa = sv.[c65536].End(3).Row
bb = sd.[c65536].End(3).Row
sd.Range("d7:d" & bb + 1) = Empty
For i = 5 To aa
For a = 7 To bb
If sv.Cells(i, "c") = "1" Then
If sv.Cells(i, "b") = sd.Cells(a, "c") Then
sd.Cells(a, "d") = "1"
sv.Cells(i, "d") = "1"
Else
End If
Else
End If
Next a
Next i
Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Dim sv As Worksheet
Dim sd As Worksheet
Dim aa, bb, i
Set sv = Sheets("veri")
Set sd = Sheets("data")
aa = sv.[c65536].End(3).Row
bb = sd.[c65536].End(3).Row
If Not Intersect(Target, Range("c5:c" & aa)) Is Nothing Then
Range("d5:D" & aa) = Empty
For i = 7 To bb
If Cells(Target.Row, "c") = "1" Then
If Cells(Target.Row, "b") = sd.Cells(i, "c") And sd.Cells(i, "e") <> "" Then
Cells(Target.Row, "d") = "1"
End If
End If
Next i
End If
Application.ScreenUpdating = True
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bul_1 As Range, Bul_2 As Range, X As Byte, Veri As Variant
On Error GoTo Son
If Intersect(Target, Range("C5:C10")) Is Nothing Then Exit Sub
If Target = 1 Then
Application.EnableEvents = False
Veri = Target
Range("C2:D10") = ""
Target = Veri
Application.EnableEvents = True
Set Bul_1 = Sheets("data").Range("C:C").Find(Target.Offset(0, -1))
If Not Bul_1 Is Nothing Then
For X = 5 To 15
If Sheets("data").Cells(Bul_1.Row, X) <> "" Then
Set Bul_2 = Range("B:B").Find(Sheets("data").Cells(Bul_1.Row, X))
If Not Bul_2 Is Nothing Then
Bul_2.Offset(0, 2) = 1
End If
End If
Next
End If
End If
Son:
Set Bul_1 = Nothing
Set Bul_2 = Nothing
Application.EnableEvents = True
End Sub