Kodları Birleştir..!

[sensizsoldum]

Merhaba ekteki not defterinde
aynı başlayan 2 tane kod var, naptımsa birleştiremedım, araştırma yaptım, anlatılanları uyguladım, ama nafile hep sorun aldım, akşama kadar bunla uğraştım. artık yayınlamak zorunda kaldım. sizlerin birleştirmesi mümkünmüdür.

 

[halit3]

İnşallah olmuştur.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, BUL As Range, Hücre As Range
Set S1 = Sheets("ŞARTLAR")
On Error GoTo Son
Application.EnableEvents = False
If Target.Cells.Count > 1 Then
For Each Hücre In Selection
If Hücre.Column = 2 Then
If Hücre.Value <> "" Then
Hücre.Offset(0, -1) = Date
Else
Hücre.Offset(0, -1).ClearContents
End If
ElseIf Hücre.Column = 3 Then
On Error Resume Next
Hücre.Comment.Delete
On Error GoTo 0
If Hücre.Value <> "" Then
Set BUL = S1.Range("B:B").Find(Hücre.Text, , , xlPart)
If Not BUL Is Nothing Then
Hücre.AddComment (BUL.Offset(0, 1).Text)
Hücre.Comment.Visible = True
End If
End If
End If
Next
ElseIf Target <> "" Then
If Target.Column = 2 Then
Target.Offset(0, -1) = Date
ElseIf Target.Column = 3 Then
Target.Select
If WorksheetFunction.CountIf(S1.Range("B:B"), "*" & Target & "*") = 1 Then
Set BUL = S1.Cells.Find(Target)
If Not BUL Is Nothing Then
Target = BUL.Value
Target.AddComment (BUL.Offset(0, 1).Text)
End If
Else
musteri.Show
End If
Set S1 = Nothing
Set BUL = Nothing
End If
Else
If Target.Column = 2 Then
Target.Offset(0, -1).ClearContents
End If
If Target.Column = 3 Then
On Error Resume Next
Target.Comment.Delete
On Error GoTo 0
End If
End If

If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Cells.Count = 1 Then
If Target <> "" Then
Cells(Target.Row, "F") = WorksheetFunction.SumIf([STOK!A:A], Target, [STOK!F:F])
Cells(Target.Row, "G") = WorksheetFunction.SumIf([GELENLER!A:A], Target, [GELENLER!D:D])
Else
Cells(Target.Row, "F") = ""
Cells(Target.Row, "G") = ""
End If
Else
For Each Hücre In Selection
If Hücre.Column = 2 Then
If Hücre.Value <> "" Then
Cells(Hücre.Row, "F") = WorksheetFunction.SumIf([STOK!A:A], Hücre.Value, [STOK!F:F])
Cells(Hücre.Row, "G") = WorksheetFunction.SumIf([GELENLER!A:A], Hücre.Value, [GELENLER!D:D])
Else
Cells(Hücre.Row, "F") = ""
Cells(Hücre.Row, "G") = ""
End If
End If
Next
End If
Son:
Application.EnableEvents = True
End Sub

 

[sensizsoldum]

Merhabalar,
Hayırlı sabahlar, hayırlı cumalar,
Evet Halit bey olmuş elinize sağlık teşekkür ederim.
Sayın Korhan bey e de sonsuz teşekkürlerimi sunarım.

Herkere iyi çalışmalar dilerim.

 

[halit3]

Merhabalar,
Hayırlı sabahlar, hayırlı cumalar,
Evet Halit bey olmuş elinize sağlık teşekkür ederim.
Sayın Korhan bey e de sonsuz teşekkürlerimi sunarım.

Herkere iyi çalışmalar dilerim.

Sizede hayırlı cumalar ve iyi çalışmalar diliyorum.