ayraçsız tarıh girişi makrosu var mı?

[ozcanya]

dostlarım bana ayraçsız tarih giriş makrosu lazım.örn.ben hücreye 121207 yazdığımda o tarih şeklini alması gerek.
sitede bulamadım.başlık var ama dosya yok.
teşekkür ederim

 

[Mahmut Kök]

dostlarım bana ayraçsız tarih giriş makrosu lazım.örn.ben hücreye 121207 yazdığımda o tarih şeklini alması gerek.
sitede bulamadım.başlık var ama dosya yok.
teşekkür ederim

Sorunuzu tam olarak anlayamadım ama aşağıdaki gibi istediğiniz şekilde ayarlayabilirsiniz.

range("a1")=format([COLOR=red]tarih[/COLOR], "ddmmyy")

 

[ozcanya]

üstat olmadı galiba
yada ben yapamadım örnek dosya eklemeniz mümkün kü?
sorum için dosya ekliyorum

 

[ozcanya]

Sayın excel üstatları bana bu konuda acil yardım gerekiyor sizden yardım bekliyorum

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdakileri, Sayfa1'in kodlarına ekleyiniz veya örnek dosyayı inceleyiniz.

NOT : A1:A100 aralığına, belirtilen formatta tarih girişleri yapılırsa çalışır. Siz kendinize uyarlarsınız.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo f1
If Not Intersect(Target, [A1:A100]) Is Nothing Then
   Target.NumberFormat = "@"
   Application.EnableEvents = False
   If Len(Target) = 6 Or Len(Target) = 8 Then
      arrchar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
      For i = 1 To Len(Target)
          For j = 0 To UBound(arrchar)
              If Mid(Target, i, 1) = arrchar(j) & "" Then: x = x + 1
              Next j
      Next i
      If x = 0 Then
         MsgBox "Yazdığınız değer, tarih için uygun değil", vbCritical, "UYARI"
         Target = Empty
         Target.Select
         GoTo f1
      End If
      x = 0
      Select Case Len(Target)
          Case 6:
             If IsDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 2)) Then
                Target = CDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 2)) * 1
             Else
                Target = Empty
                Target.Select
                GoTo f1
             End If
          Case 8
             If IsDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 4)) Then
                Target = CDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 4)) * 1
                Target = Empty
                Target.Select
                GoTo f1
             End If
      End Select
      Target.NumberFormat = "dd/mm/yyyy"
   Else
      MsgBox "Tarih için 6 veya 8 karakterlik veri girmelisiniz", vbCritical, "UYARI"
      Target = Empty
      Target.Select
      GoTo f1
   End If
End If
f1:
Application.EnableEvents = True
End Sub

 

[Seyit Tiken]

Hücre Biçimlendirme > İsteğe Uyarlanmış > Tür, 00"."00"."0000 şeklinde yazıp deneyiniz.

 

[Ferhat Pazarçevirdi]

Hücre Biçimlendirme > İsteğe Uyarlanmış > Tür, 00"."00"."0000 şeklinde yazıp deneyiniz.

Seyit Tiken Hocam, eğer senin çözüm doğruysa -ki ben bu durumda soruyu yanlış anlamış oluyorum- yanarım yanarım, harcadığım zamana (Çözümünüz çok pratik çünk&#252

 

[ozcanya]

Sayın fpc teşekkür ederim her zaman ki gibi bana siz yardım ettiniz.
çok işime yaradı fakat hücreye iki haneli sayı da girmem gereken zamanlarda iki haneli sayı giremiyorum.
buda mümkün mü?
saygılar sunarım.
Ayrıca forumdaki yeriniz hayırlı olsun

 

[ozcanya]

sayın seyit Tiken hocam denedim olmadı Yada ben mi yapamadım
dosya ekleyerek sizden rica etsem
Çünkü sayın fpc nin dediği gibi çözüm çok piratik olacak

 

[Ferhat Pazarçevirdi]

Teşekkürler Özcan bey,

çok işime yaradı fakat hücreye iki haneli sayı da girmem gereken zamanlarda iki haneli sayı giremiyorum.

Peki, 6 basamaklı bir sayı girdiğinizde bunun tarih olup olmadığının kontrolü de yok, bu kodlarda ... 6 ve 8 basamaklı, tamamı sayılardan oluşan ne girerseniz girin tarih olarak algılamakta ...

Onun için, varyasyonlara göre hareket etmek gerekiyor. Yani, siz bu alana neleri giriyorsanız ona göre, bütün alternatifleri içeren kod üretilmesi gerekiyor.

Örneğin, girilen değer 6 veya 8 karakter uzunluğunda değilse, prosedür devre dışı kalıyor. Söylediklerinize göre, bunun dışındaki uzunluklar için de ayrı kodlama (veya koda ekleme) yapılması gerekir.

 

[ozcanya]

Yani üstat mümkünse iki hane sayı girmek bazen gerekiyor.eğer oluyorsa çok sevinirim teşekkürler
ben hücreye ya tarih 6 haneli yada 2 haneli sayı giriyorum.Başka bir şey yazmıyorum

 

[Seyit Tiken]

Seyit Tiken Hocam, eğer senin çözüm doğruysa -ki ben bu durumda soruyu yanlış anlamış oluyorum- yanarım yanarım, harcadığım zamana (Çözümünüz çok pratik çünkü)

Sayın fpc, bu yöntem sadece görüntüyü kurtarıyor.

 

[Ferhat Pazarçevirdi]

Yani üstat mümkünse iki hane sayı girmek bazen gerekiyor.eğer oluyorsa çok sevinirim teşekkürler
ben hücreye ya tarih 6 haneli yada 2 haneli sayı giriyorum.Başka bir şey yazmıyorum

O zaman, kodları aşağıdaki gibi revize edin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo f1
If Not Intersect(Target, [A1:A100]) Is Nothing Then
   Target.NumberFormat = "@"
   Application.EnableEvents = False
   If Len(Target) = 6 Or Len(Target) = 8 Then
      arrchar = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
      For i = 1 To Len(Target)
          For j = 0 To UBound(arrchar)
              If Mid(Target, i, 1) = arrchar(j) & "" Then: x = x + 1
              Next j
      Next i
      If x = 0 Then
         MsgBox "Yazdığınız değer, tarih için uygun değil", vbCritical, "UYARI"
         Target = Empty
         Target.Select
         GoTo f1
      End If
      x = 0
      Select Case Len(Target)
          Case 6:
             If IsDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 2)) Then
                Target = CDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 2)) * 1
             Else
                Target = Empty
                Target.Select
                GoTo f1
             End If
          Case 8
             If IsDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 4)) Then
                Target = CDate(Left(Target, 2) & "/" & Mid(Target, 3, 2) & "/" & Right(Target, 4)) * 1
                Target = Empty
                Target.Select
                GoTo f1
             End If
      End Select
      Target.NumberFormat = "dd/mm/yyyy"
   ElseIf Len(Target) <= 2 Then
[COLOR=green]'      Target.NumberFormat = "@"[/COLOR]
   Else
      MsgBox "2, 6 veya 8 karakterlik veri girmelisiniz", vbCritical, "UYARI"
      Target = Empty
      Target.Select
      GoTo f1
   End If
End If
f1:
Application.EnableEvents = True
End Sub

 

[ozcanya]

Üstat tamamdır oldu
Bilginize sağlık emeğinize sağlık
samsundan selamlar...