tarihten saat kaldırma ve adres düzenleme

[m.ensar]

Merhaba;
listeme net üzerinden veri ekliyorum ve bu veriler

88888

SÜLEYMAN AKSOY

SAMSUN

55555

Kimlik Kartı Başvuru Süreci Devam Ediyor

23.12.2022 07:51:45

DENEME MAH. ÖRNEK SK. NO: 7

şeklinde alınıyor bunu listeme yapıştırdığımda 23.12.2022 07:55:45 olan tarih kısmından saati kaldırıp 23.12.2022 şeklinde ve adres kısmınında DENEME MAH. buraya kadar olan kısmını almak istiyorum. bunu listeme eklediğimde otomatik düzeltebilecek bir kod var mıdır? tarih kısımı G sütununda adres kısmı H sütununda

 

[Korhan Ayhan]

Merhaba,

Sayfanızın kod bölümüne uygulayıp deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    
    On Error GoTo 10
    
    If Intersect(Target, Range("G3:H1048576,R3:1048576")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    For Each Rng In Range("G3:G1048576").SpecialCells(xlCellTypeConstants)
        Rng = Int(CDbl(Rng))
        Rng.NumberFormat = "dd.mm.yyyy"
    Next
    
    For Each Rng In Range("H3:H1048576").SpecialCells(xlCellTypeConstants)
        If Rng Like "*MAH.*" Then
            Rng = Split(Rng, "MAH.")(0) & "MAH."
        End If
    Next
    
    For Each Rng In Range("R3:R1048576").SpecialCells(xlCellTypeConstants)
        If Rng = "" Then
            Cells(Rng.Row, "F") = ""
        Else
            If UCase(Replace(Replace(Rng, "ı", "I"), "i", "İ")) = "TESLİM EDİLDİ" Then
                Cells(Rng.Row, "F") = "Hizmeti Başladı"
            End If
        End If
    Next

10  Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[m.ensar]

Hocam ilginiz için çok teşekkür ederim. sanırım başka kod da olduğu için bu hatayı verdi kodları silip sadece sizin kodu yazdığımda bir işlem yapmadı Sizin kodunda ekli olduğu örnek çalışma ekliyorum

 

[Korhan Ayhan]

Asıl dosyanızdaki durumları bizler maalesef bilemiyoruz.

Karşılaştığınız hata ise aynı kod bloğundan birden fazla olamayacağı yönündedir. İki aynı prosedürü birleştirmek gerekiyor.

Kodun çalışması için veri aralığında bir hücrede değişiklik yapmanız yada kopyala-yapıştır yapmanız yeterli olacaktır.

 

[m.ensar]

kod çalıştı hocam G2 ve H2 kod içersinde bu şekilde idi ancak bende 3. satırdan başlıyor onu düzeltince problem ortadan kalktı ama 2 prosedürü tek kod beni baya bir aşıyor ekteki liste içerisinde kodlar var vaktiniz olursa bakabilir misiniz?

 

[Korhan Ayhan]

Üstte ki mesajımda önerdiğim kodu revize ettim.

Dosyanızdaki Private Sub Worksheet_Change(ByVal Target As Range) prosedürlerini silip yerine revize ettiğim kodu uygulayınız.

 

[m.ensar]

Korhan hocam sağolasınız alakanızdan dolayı 3 ayrı liste ekliyorum revize ettiğiniz kodların sade hali çalışmaya entegre hali ve eski çalışan haliyle revize ettiğiniz kod sade haliyle hiç tepki vermedi entegre ettiğimde hata verdi sanırım ben de bir yanlışlık var. ilk yazdığınız kod ise tek olunca çalışıyor. hocam zaman zaman buradan çok fazla yardım istiyorum ama bu çalışmaların hiç birini ben kullanmıyorum arkadaşların işini kolaylaştırmak için uğraşıyorum eğer vaktiniz olursa tekrar bakabilir misiniz. çok teşekkür ediyorum herşey için