- Katılım
- 12 Kasım 2016
- Mesajlar
- 131
- Excel Vers. ve Dili
- Excel 2016
- Altın Üyelik Bitiş Tarihi
- 08/01/2023
formda da bir kaç örnegini görsemde iki kodu birleştiremedim. Vba kodunu bilen arkadaşlar için basit olsa gerek ama bilmeyen için zor. Kodu aşagıda mevcut birleştirme yapsanız bile kısaca olsa tam neye dikkat edecegimizide yazarsanız sevinirim.
Private Sub Worksheet_Change(ByVal Target As Range)
alan = "I2:I" & Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA")
If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub
sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
With m.Cells(sat, sut)
.ClearComments
If Target <> "" Then
.AddComment: .Comment.Text Text:=Target.Text
End If
End With
End Sub
BİRLEŞECEK DİGER VBA KODU
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B9]) Is Nothing Then Exit Sub
Cells(Target.Row, "C").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 2, 0)
Cells(Target.Row, "D").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 4, 0)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
alan = "I2:I" & Cells(Rows.Count, "A").End(3).Row
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
Set wf = Application.WorksheetFunction
Set m = Sheets("MESAİ"): Set md = Sheets("MESAİDATA")
If wf.CountIf(m.[C:C], md.Cells(Target.Row, "B")) = 0 Or _
wf.CountIf(m.[3:3], md.Cells(Target.Row, "A")) = 0 Then Exit Sub
sat = wf.Match(md.Cells(Target.Row, "B"), m.[C:C], 0) + 2
sut = wf.Match(md.Cells(Target.Row, "A"), m.[3:3], 0)
With m.Cells(sat, sut)
.ClearComments
If Target <> "" Then
.AddComment: .Comment.Text Text:=Target.Text
End If
End With
End Sub
BİRLEŞECEK DİGER VBA KODU
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B9]) Is Nothing Then Exit Sub
Cells(Target.Row, "C").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 2, 0)
Cells(Target.Row, "D").Value = Application.WorksheetFunction.VLookup(Cells(Target.Row, "B"), Sheets("SÜRÜCÜ").Range("A:E"), 4, 0)
End Sub