Bu makrolar nasıl birleştirilir?

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
2,283
Excel Vers. ve Dili
2010 - Türkçe 64 Bit
Merhaba Arkadaşlar,
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
3,490
Excel Vers. ve Dili
2013
Merhaba.

Aşağıdaki kodu kullanın.

Kod:
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

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
2,283
Excel Vers. ve Dili
2010 - Türkçe 64 Bit
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
3,490
Excel Vers. ve Dili
2013
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ı.

Kod:
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

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
2,283
Excel Vers. ve Dili
2010 - Türkçe 64 Bit
Sayın Dalgalıkur,
İlginize çok teşekkür ederim.
Saygılarımla
 
Üst