Makroları birleştirme

[asuzen]

Merhabalar.
Elimde iki tane Worksheet_Change makrosu var. Bunların aynı sayfada aynı anda çalışmadığı için birleştirmeyi denedim ancak bir türlü yapamadım. Örnek makrolara da bakıp değişik şeyler denedim ama maalesef olmadı. Bu konuda bana yardımcı olabilir misiniz?

Biri "C" sütünuna "2045" şeklinde yazdığım saati "20:45" yapıyor, diğeri ise "B" sütununa "04102015" şeklinde yazdığım tarihi "04 Ekim 2015 Pazar" şekline dönüştürüyor.

Private Sub Worksheet_Change(ByVal Target As Range)
 
   If Intersect(Target, [c:c]) Is Nothing Or Target.Row < 2 Then Exit Sub
 
    Application.EnableEvents = False
  On Error Resume Next
    Target = TimeSerial(Int(Target.Value / 100), Target.Value Mod 100, 0)
  On Error Resume Next
   Application.EnableEvents = True

 On Error Resume Next
End Sub
 
 
 
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sonuc   As Boolean, _
    Gun     As Integer, _
   Ay      As Integer, _
   Yil     As Long, _
  Aylar
 Aylar = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Row < 2 Then Exit Sub
Application.EnableEvents = False
Sonuc = True
   Target.NumberFormat = "General"
If Len(Target) > 8 Then
    MsgBox "Çok uzun tarih girişi"
ElseIf Len(Target) < 7 Then
    MsgBox "Çok kısa tarih girişi"
ElseIf Len(Target) = 8 Then
    Yil = Right(Target.Value, 4)
    Ay = Mid(Target.Value, 3, 2)
    Gun = Left(Target.Value, 2)
Else
    Yil = Right(Target.Value, 4)
    Ay = Mid(Target.Value, 2, 2)
    Gun = Left(Target.Value, 1)
End If
If Gun = 0 Or Gun > Aylar(Ay) Then Sonuc = False
If Ay = 0 Or Ay > 12 Then Sonuc = False
If Ay = 2 And Gun > Aylar(Ay) Then Sonuc = False
If Sonuc = False Then
    Target.Offset(0, 0).Select
    Target.Value = ""
Else
    Target = DateSerial(Yil, Ay, Gun)
End If
Target.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Application.EnableEvents = True
End Sub

İlginiz için şimdiden teşekkür ederim...

 

[Tevfik_Kursun]

Merhaba sayın Asuzen,
Bunun için makroya ihtiyacınız yok gibi düşünüyorum.
Örnek ekte
İyi çalışmalar

 

[asuzen]

Merhaba Sayın Tevfik_Kursun,
Örneğinizdeki gibi hücre biçimlendirme ile yapılabiliyor ancak özellikle tarih kısmı genelde sorun çıkarmakta. Daha sonra yapılacak süzme ve aktarma işlemlerinde de aynı sorunlar yaşanmakta. Onun için hücre biçimlendirme yerine bu yöntemi kullanmaktayım. Yine de ilginiz ve cevabınız için teşekkür ederim.

 

[Tevfik_Kursun]

Rica ederim, kolay gelsin.
Ben size mani olmuş oldum. Özür dilerim. Siz lütfen konuyu bir daha açın.
İyi çalışmalar

 

[ÖmerBey]

Merhaba,
Şu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Not Intersect(Target, [c:c]) Is Nothing And Target.Row >= 2 Then
    Application.EnableEvents = False
    On Error Resume Next
    Target = TimeSerial(Int(Target.Value / 100), Target.Value Mod 100, 0)
    On Error Resume Next
    Application.EnableEvents = True
ElseIf Not Intersect(Target, [B:B]) Is Nothing Then
    Dim Sonuc   As Boolean, _
    Gun     As Integer, _
    Ay      As Integer, _
    Yil     As Long, _
    Aylar
    Aylar = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

    If Target.Row < 2 Then Exit Sub
    Application.EnableEvents = False
    Sonuc = True
    Target.NumberFormat = "General"
    If Len(Target) > 8 Then
        MsgBox "Çok uzun tarih girişi"
    ElseIf Len(Target) < 7 Then
        MsgBox "Çok kısa tarih girişi"
    ElseIf Len(Target) = 8 Then
        Yil = Right(Target.Value, 4)
        Ay = Mid(Target.Value, 3, 2)
        Gun = Left(Target.Value, 2)
    Else
        Yil = Right(Target.Value, 4)
        Ay = Mid(Target.Value, 2, 2)
        Gun = Left(Target.Value, 1)
    End If
    
    If Gun = 0 Or Gun > Aylar(Ay) Then Sonuc = False
    If Ay = 0 Or Ay > 12 Then Sonuc = False
    If Ay = 2 And Gun > Aylar(Ay) Then Sonuc = False
    
    If Sonuc = False Then
        Target.Offset(0, 0).Select
        Target.Value = ""
    Else
        Target = DateSerial(Yil, Ay, Gun)
    End If
    
    Target.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
    Application.EnableEvents = True
End If
End Sub

 

[asuzen]

Teşekkür ederim hocam çalıştı. Elinize sağlık.

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...