Bu makrolar nasıl birleştirilir?

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Set Alan = Range("B1:B154")
    Application.MoveAfterReturnDirection = xlToRight
    If Intersect(Target, [B1:B154]) Is Nothing Then Exit Sub
    If Target = "" Then
        Target.Offset(0, 1) = ""
    Else
        Target.Offset(0, -1) = Date
        Application.ScreenUpdating = False
        Target.Offset(0, 1).Select
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range([F1].Text)) Is Nothing Then
        With Range([G1].Text)
            .FormatConditions.Delete
            .FormatConditions.Add xlCellValue, xlEqual, "=" & Target.Address
            .FormatConditions(1).Interior.ColorIndex = 6
            .FormatConditions(1).Font.Color = -16776961
        End With
    End If
End Sub

makrolar bulundukları sayfada düzgün olarak çalışmaktalar. Case yöntemiyle birleştirilebilirler diye düşündüm ama başaramadım. Hangi yöntemle olursa olsun kursor A:C sütunlarında ise ilk makro, H sütununda ise 2. makronun çalışmasını istiyorum. Yardımcı olursanız çok makbule geçer.
Saygılarımla

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu kullanın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range([F1].Text)) Is Nothing Then
        With Range([G1].Text)
            .FormatConditions.Delete
            .FormatConditions.Add xlCellValue, xlEqual, "=" & Target.Address
            .FormatConditions(1).Interior.ColorIndex = 6
            .FormatConditions(1).Font.Color = -16776961
        End With
    ElseIf Not Intersect(Target, [B1:B154]) Is Nothing Then
        Application.MoveAfterReturnDirection = xlToRight
        If Target = "" Then
            Target.Offset(0, 1) = ""
        Else
            Target.Offset(0, -1) = Date
            Target.Offset(0, 1).Select
        End If
    End If
End Sub

 

[Tevfik_Kursun]

Merhaba,
İlginize çok teşekkür ederim. B sütununda hücreye rakam yazdığımda A sütununa geçip tarih atıp C sütununa sıçrıyordu. Şimdi B den C ye geçiyor ve kalıyor. Doldurup B ye dönerseniz A sütununa geçip tarih atıp C sütununa sıçrıyor.
Saygılarımla

 

[Muzaffer Ali]

Dikkatimden kaçmış.
Bu iki kod birleştirilemez.
Biri hücre seçimi yapınca çalışması gerekiyor diğeri hücrede bir değişiklik yapınca çalışması gerekiyor.
Kodlar aşağıdaki gibi olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B1:B154]) Is Nothing Then
        Application.MoveAfterReturnDirection = xlToRight
        If Target = "" Then
            Cells(Target.Row, "C") = ""
        Else
            Cells(Target.Row, "A") = Date
            Cells(Target.Row, "C").Select
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range([F1].Text)) Is Nothing Then
        With Range([G1].Text)
            .FormatConditions.Delete
            .FormatConditions.Add xlCellValue, xlEqual, "=" & Target.Address
            .FormatConditions(1).Interior.ColorIndex = 6
            .FormatConditions(1).Font.Color = -16776961
        End With
    End If
End Sub

 

[Tevfik_Kursun]

Sayın Dalgalıkur,
İlginize çok teşekkür ederim.
Saygılarımla