• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kod'da Birleştirme ve Düzenleme

Katılım
5 Kasım 2007
Mesajlar
4,727
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Merhaba,

Sayfanın kod'una aşağıdaki 2 kodu yazınca, doğal olarak çakışma oluyor,

İsteğim;

1) Bu 2 kodun tek kod olarak birleşmesi,

2) Üstteki kod'da "UserName" yerine StatusBar'da yazan ismi yada "ANASAYFA" isimli sayfada B10'da (StatusBar'da yazan ile aynıdır) yazan ismi alması,

Teşekkür ederim.

Kod:
[COLOR="blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
If Not Intersect(Target, [A5:T300]) Is Nothing Then
Cells(Target.Row, "X") = Format(Now, "dd/mmmm/yyyy - hh:mm:ss") _
& " - " & Environ("[COLOR="Red"]UserName[/COLOR]")
End If
End Sub

Kod:
[COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
    If Intersect(Target, Range("H5:H125")) Is Nothing Then Exit Sub
    With Target
        If IsDate(.Value) = True Then
           .Offset(0, 2).Resize(1, 2).ClearContents
        End If
 End With
End Sub
 
Merhaba
Aşağıdaki gibi iki şekilde olabilir
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A5:T300]) Is Nothing Then
Cells(Target.Row, "X") = Format(Now, "dd/mmmm/yyyy - hh:mm:ss") _
& " - " & Application.StatusBar
 If Not Intersect(Target, Range("H5:H125")) Is Nothing Then
    With Target
        If IsDate(.Value) = True Then
           .Offset(0, 2).Resize(1, 2).ClearContents
        End If
 End With
End If
End If
End Sub

veya "H" sütununa sadece tarih girildiğinde "x" sütununa veri yazılacaksa

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A5:T300]) Is Nothing And Intersect(Target, Range("H5:H125")) Is Nothing Then
Cells(Target.Row, "X") = Format(Now, "dd/mmmm/yyyy - hh:mm:ss") _
& " - " & Application.StatusBar
End If
 If Not Intersect(Target, Range("H5:H125")) Is Nothing Then
    With Target
        If IsDate(.Value) = True Then
           .Offset(0, 2).Resize(1, 2).ClearContents
        End If
 End With
End If
End Sub
 
Sayın PLİNT merhaba,

Çözüm ve duyarlığınız için çok çok teşekkür ederim, sağ olun.

Saygılarımla.
 
Geri
Üst