BU İKİ KODU
BUÇALIŞMAKİTABI
NDA AYNI ANDA KAYDEDEREK NASIL KULLANABİLİRİM
YANİ POL DOSYASINDAKİ P VE Q SÜTUNLARINA GİRİLEN İSİMLERİ GEÇİCİ GÖREV DOSYASINDA İSİMLERİ KARŞILIĞINA GELEN E VE F SÜTÜNLARINDAKİ KARŞILIKLARINI YAZDIRMAK İSTİYORUM
BU İKİ KODU AYRI AYRI KAYDETTİĞİMDE SORUN YOK AMA İKİSİNİ BİRDEN NASIL AKTİF HALE GETİREBİLRİM
KOD 1
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim satBul As Long
Dim comm As String
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("P")) Is Nothing Then Exit Sub
Set wb = Workbooks("geçici görev.xls")
On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("B"), 0)
If Err.Number = 0 Then
With wb.Worksheets("Sayfa1").Cells(satBul, "F")
.Value = "MGAZİ/SKAYA"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -15).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub
KOD2
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim satBul As Long
Dim comm As String
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("Q")) Is Nothing Then Exit Sub
Set wb = Workbooks("geçici görev.xls")
On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("B"), 0)
If Err.Number = 0 Then
With wb.Worksheets("Sayfa1").Cells(satBul, "E")
.Value = "ŞİRİNTEPE"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -16).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub
BUÇALIŞMAKİTABI
NDA AYNI ANDA KAYDEDEREK NASIL KULLANABİLİRİM
YANİ POL DOSYASINDAKİ P VE Q SÜTUNLARINA GİRİLEN İSİMLERİ GEÇİCİ GÖREV DOSYASINDA İSİMLERİ KARŞILIĞINA GELEN E VE F SÜTÜNLARINDAKİ KARŞILIKLARINI YAZDIRMAK İSTİYORUM
BU İKİ KODU AYRI AYRI KAYDETTİĞİMDE SORUN YOK AMA İKİSİNİ BİRDEN NASIL AKTİF HALE GETİREBİLRİM
KOD 1
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim satBul As Long
Dim comm As String
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("P")) Is Nothing Then Exit Sub
Set wb = Workbooks("geçici görev.xls")
On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("B"), 0)
If Err.Number = 0 Then
With wb.Worksheets("Sayfa1").Cells(satBul, "F")
.Value = "MGAZİ/SKAYA"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -15).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub
KOD2
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim satBul As Long
Dim comm As String
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("Q")) Is Nothing Then Exit Sub
Set wb = Workbooks("geçici görev.xls")
On Error Resume Next
satBul = Application.Match(Target.Value, wb.Worksheets("Sayfa1").Columns("B"), 0)
If Err.Number = 0 Then
With wb.Worksheets("Sayfa1").Cells(satBul, "E")
.Value = "ŞİRİNTEPE"
comm = .Comment.Text
.Comment.Delete
.AddComment Text:=comm & " " & Target.Offset(, -16).Text
End With
Else
Exit Sub
End If
On Error GoTo 0
End Sub
