iki makroyu birleştirme

[zehfeysal]

aynı sayfada hüçreye değer girilince tarihi otomatik atan makrom var
sizin makronuzla sayfadaki makroyu nasıl birleştirebiliriz. bir turlu beceremedim.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A:A"), Target) Is Nothing Then
Cancel = True
Target.Value = Now
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3:b65536]) Is Nothing Then Exit Sub
If Target.Column = 5 Then
Atla = 5
Else
Atla = 5
End If
If Target > "" Then
Target.Offset(0, Atla) = Now
Else
Target.Offset(0, Atla) = ""
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{DEL}", "UYARI"

End Sub


ikinci makro

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or Target.Value = "" Then Exit Sub
Dim c As Range

Set c = Sheets("Parametreler").Range("E:E").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Target.Offset(0, 1) = Sheets("Parametreler").Range("F" & c.Row)
Else
Target.Offset(0, 1) = "Bulunamadı.."
End If

End Sub

Alıntı Cevapla
Şikayet Et!

 

[Necdet]

Merhaba,

Sizin istediğiniz Worksheet_Change makrolarının birleşmesi, diğer makroları neden yazdınız anlamadım.

İlk change makrosunda ne yaptığınız anlaşılmıyor, ya da ben anlamadım. Anlamadan iki makroyu birleştirmek zor.

 

[zehfeysal]

ilk makro B hücresinde secim yapılınca G hücresine otomatik tarih atıyor
ikinci makro B hücresinde secim yapılınca C hücresine veri getiriyor ( makro ile düseyara yapıp parametreler de ki karşılıgını getiyor )

 

[Necdet]

Aşağıdaki kodları bir deneyin, sonucu belirtin.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or Target.Value = "" Then Exit Sub
    Dim c As Range
    
    If Target.Value = "" Then
        Target.Offset(0, 1) = ""
        Target.Offset(0, 5) = ""
    Else
        Target.Offset(0, 5) = Now
        Set c = Sheets("Parametreler").Range("E:E").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Target.Offset(0, 1) = Sheets("Parametreler").Range("F" & c.Row)
        Else
            Target.Offset(0, 1) = "Bulunamadı.."
        End If
    End If
    
End Sub

 

[zehfeysal]

istediğim gibi olmuş elinize sağlık tesekkurler
tek sıkıntı b hucresindeki veri silersem c ve g hucreleri dolu kalıyor silin miyor

 

[Necdet]

istediğim gibi olmuş elinize sağlık tesekkurler
tek sıkıntı b hucresindeki veri silersem c ve g hucreleri dolu kalıyor silin miyor

Merhaba, kodları yeniledim, tekrar deneyiniz.

 

[zehfeysal]

necdet bey tesekkur ederim elinize sağlık