Ters yazılmış olan tarihleri toplu olarak normal tarihe çevirme

[ASLAN7410]

Merhaba hayırlı günler.

Ekte gönderdiğim excel dosyamda bazı sütunlarda sistemden alınan ters yazılmış tarihler mevcut, bu tarihlerin başında veya sonunda bazen boşluklarda oluyor,
yapmak istediğim butona bastığımda bu tarihleri toplu olarak verinin olduğu aynı sütunda normal tarihe çevirmek istiyorum.

=TARİH(PARÇAAL(J10;3;4);PARÇAAL(J10;7;2);PARÇAAL(J10;9;2)) bu formülle tarihleri normal tarihe çeviriyorum ancak, bu işlemde uzun sürüyor.


Yardımcı olur musunuz?

 

[Ömer BARAN]

Merhaba.

Mevcut kod'daki Else ve altındaki MsgBox satırının arasına aşağıdaki kod satırlarını yapıştırıp deneyiniz.
İlgili sütundaki verilerin standart olarak YYYYAAGG şeklinde 8 karakter olarak yazılmış olduğu varsayıldı.

Sub SütunDüzelt()
sor = Application.InputBox("Düzeltilecek sütun harfi giriniz!.." & vbCrLf & " ", "ASLAN", "A")
sor = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(sor, "ç", "c"), _
    "Ç", "C"), "ğ", "G"), "Ğ", "G"), "ö", "O"), "ö", "O"), "ş", "S"), "Ş", "S"), "ü", "U"), "Ü", "U")
If sor = False Then
    MsgBox "İşlemi iptal ettiniz.", vbInformation, "ASLAN"
    Exit Sub
Else
    Application.DisplayAlerts = False
    Columns(sor).Replace What:=Chr(32), Replacement:=""
    Columns(sor).Replace What:=Chr(64), Replacement:=""
    say = 0: ilk = Cells(1, sor).End(xlDown).Row
    son = Cells(Rows.Count, sor).End(3).Row
        If ilk > son Then
            MsgBox "Belirtilen sütunda veri yok"
            Exit Sub
        Else
            ilk = Cells(1, sor).End(xlDown).Row
        End If
    For sat = ilk To son
        On Error Resume Next
        If IsNumeric(Right(1 * Cells(sat, sor), 1)) Then
            asil = Cells(sat, sor)
            If Cells(sat, sor) <> "" And Len(1 * Cells(sat, sor)) = 8 Then
                Cells(sat, sor).NumberFormat = "dd/mm/yyyy": say = say + 1
                Cells(sat, sor) = DateValue( _
                                Mid(1 * Cells(sat, sor), 7, 2) & "/" & _
                                Mid(1 * Cells(sat, sor), 5, 2) & "/" & _
                                Mid(1 * Cells(sat, sor), 1, 4))
            If Cells(sat, sor) = asil Then say = say - 1
        End If
        End If
10:    Next
    If say < 1 Then
        MsgBox "Sütunda işlem yapılacak veri yok."
    Else
        MsgBox UCase(sor) & " sütununda, " & vbLf & say & " adet" & vbLf & _
        "veri istenilen tarih biçimine getirildi.", vbInformation, "ASLAN"
    End If
End If
    Application.DisplayAlerts = True
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, ilginiz için çok teşekkür ediyorum, çok yardımınız oldu.

Gönderdiğiniz kodu dediğiniz gibi yaptım, butona bastığımda inputbox kutusuna D harfini yazıp tamam dediğimde sadece D sütunundaki en son veri olan iki tane tarihi normal tarihe çeviriyor, tekrar inputbox kutusuna D yazdığımda bu seferde hata veriyor, J sütunundaki verilerin arasında boşluk olmadığı için bu sütunu normal tarihe çeviriyor.
Tarihlerin arasında boş hücre olduğu zaman hata veriyor.

Bunu düzeltirseniz süper olacak.

 

[Ömer BARAN]

Kodu yenilemiştim, siz de o arada bakmışsınız.
Sayfayı yenileyerek kod cevabıma tekrar bakınız.

Şimdi bilgisayar başından kalkmalıyım, sorun olursa akşam tekrar bakarım.
.

 

[ASLAN7410]

Sayın Ömer Bey, sonunda boşluk olan ters yazılı tarihler düzelmedi.

Ayrıca inputbox kutusuna veri olmayan bir sütun harfi yazılırsa, örneğin B sütununda veri yok şeklinde uyarı verebilir mi?

 

[Ziynettin]

Merhaba,

Bu şekilde deneyiniz.

Sub SütunDüzelt()
sor = Application.InputBox("Düzeltilecek sütun harfi giriniz!.." & vbCrLf & " ", "ASLAN", "A")
sor = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(sor, "ç", "c"), _
    "Ç", "C"), "ğ", "G"), "Ğ", "G"), "ö", "O"), "ö", "O"), "ş", "S"), "Ş", "S"), "ü", "U"), "Ü", "U")
If sor = False Then
    MsgBox "İşlemi iptal ettiniz.", vbInformation, "ASLAN"
    Exit Sub
Else
    son = Cells(Rows.Count, sor).End(3).Row
    If son > 1 Then
        a = Cells(1, sor).Resize(Cells(Rows.Count, sor).End(3).Row)
        For i = 1 To UBound(a)
            If Not a(i, 1) = "" Then
                trh = Application.Trim(a(i, 1))
                gun = Right(trh, 2)
                ay = Mid(trh, 7, 2)
                yil = Left(trh, 6)
                On Error Resume Next
                tarih = DateSerial(yil, ay, gun)
                If IsDate(tarih) Then
                    Cells(i, sor) = tarih
                Else
                    Cells(i, sor) = Cells(i, sor)
                End If
            End If
        Next i
        MsgBox sor & " sütunu istenilen tarih biçimen getirildi.", vbInformation, "ASLAN"
    End If
End If
End Sub

 

[ASLAN7410]

Sayın Ziynettin Bey, ellerinize sağlık süper olmuş.

Bir kaç dokunuş daha olursa daha da süper olacak.

Inputbox içerisine veri olmayan sütun harfi yazıldığı zaman örneğin A sütunuda veri yok şeklinde bir mesaj verilebilir mi?
Inputbox içerisine istenilen sütun başlığı küçük harf dahi yazılırsa işlem bitince mesaj kutusunda bu harf büyük harf şeklinde yazılabilir mi? Örneğin D sütunu istenilen tarih biçimine getirildi şeklinde olmasını istiyorum.
Inputbox içerisine tarih olmayan başka veriler olan bir sütun harfi yazınca kod hata veriyor, bu işlemde de Tarih sütununu seçiniz şeklinde bir mesaj verilebilir mi?

 

[alicimri]

Dosyanızı inceleyemedim ama pratik olacağını düşündüğüm bir yol öneriyim.
İlgili sütunu seçin Metni Sütunlara Dönüştür sihirbazını çalıştırın ilk iki adımı hiç bir şey yapmadan geçin 3. adımda Tarih i seçin Yanındaki listeden YAG işaretleyin sona tıklayın.
sütunda karışık olarak da olsa 20180101, 2018 01 01, 2018/01/01 formatlarındaki metin dizelerini tarih değerine (01.01.2018 şeklinde) dönüştürür.

 

[ASLAN7410]

Sayın Ali Bey, ilginiz için çok teşekkür ediyorum, dediğiniz gibi yaptım yapılan işlem sütuna hiç bir şey yapmıyor.

 

[alicimri]

Dosya yapınızı bilmiyorum ama ben değişik şekillerde denedim, önerdiğim işlem sonuç veriyor.
Dosyanızı bir paylaşım sitesine eklerseniz birde öyle deneyim.

 

[ASLAN7410]

Sayın Ali Bey, linki ekledim.

http://dosya.co/54bx9wivvhxp/Örnek1.xlsm.html

 

[Ömer BARAN]

Önceki kod cevabımı tekrar güncelledim.
Sayfayı yenileyerek 2 numaralı cevabı kotrol ediniz.

 

[ASLAN7410]

Sayın Ömer Bey, ellerinize sağlık kod süper çalışıyor ancak küçük bir sorun var bu da çözülürse valla süper olacak.

Inputbox içerisine tarih olmayan başka veriler olan bir sütun harfi yazınca kod hata veriyor, bu işlemde de Tarih yazan sütunu seçiniz şeklinde bir mesaj verilebilir mi?

 

[Ömer BARAN]

Önceki cevabımı tekrar kontrol edin.
Kırmızı renklendirdiğim kısımlar eklendi veya değiştirildi.
.

 

[ASLAN7410]

Sayın Ömer Bey, kusura bakmayın uğraştırdım, ama tam istediğim gibi oldu.

Çok teşekkür ediyorum, Allah razı olsun, hayırlı geceler diliyorum.

 

[Ömer BARAN]

Kolay gelsin.

 

[alicimri]

Hücrelerin başında iki tip boşluk var, boşluğun biri 32 Asci kodlu diğeri 160 kodlu, 160 kodlu boşluk sorun çıkartıyor. Bu durumda arkadaşların çözümleri daha uygun olacak.

 

[Ömer BARAN]

Ben de o nedenle 1 * Cells(sat, sor) şeklinde işlem yapılmasını önermiş idim.

 

[Erdem Akdemir]

Metni sütunlara dönüştür ile formülsüz ve makrosuz yapılabilir.

Sabit Genişlikli'yi seçin. Tarihleri çizgilerin arasında başlayıp bitecek şekilde seçin.
Veri Önizleme alanında 3 tane alan gelecek.
1. ve 3. alanı seçerek Sütünu içeri aktarma(atla)'yı tıklayın.
2.alanı seçtiğinizde ise tarih'i tıklayın ve YAG'ı seçin.

Tamam dediğinizde işlem tamamdır. Doğru yaparsanız işlem yapılır.
Eklediğiniz dosya üzerinde deneme yaptım.

 

[ASLAN7410]

Sayın kuvari ilginiz için çok teşekkür ediyorum, maalesef yapamadım.