Fonksiyon veya VBA ile kolondaki formatı başka formata çevirme

[EMREKAYA]

Merhaba arkadaşlar,

Elimde ekteki gibi bir okuma saat tablosu var. Okuma zamanını sağ tarafa PDOP formatına çevirmem gerekiyor. Bunu programlaya bilirmiyiz?

şimdiden teşekkürler...
EMRE

 

[YUSUF44]

Aşağıdaki kodlar ilgili önce formül kullanarak dönüşümü yapıyor sonra da C sütununu kopyalayıp değer olarak yapıştırıyor:

Sub PDOP()
Application.ScreenUpdating = False
a = Cells(Rows.Count, 1).End(3).Row
For i = 2 To a
 Cells(i, 3).FormulaR1C1 = "=TEXT(YEAR(RC[-2]*1),""0000"")&""Y""&TEXT(MONTH(RC[-2]*1),""00"")&""M""&TEXT(DAY(RC[-2]*1),""00"")&""D""&TEXT(HOUR(RC[-2]*1),""00"")&""H""&TEXT(MINUTE(RC[-2]*1),""00"")&""M""&TEXT(SECOND(RC[-2]*1),""00"")&""S"""
Next
Range(Cells(2, 3), Cells(a, 3)).Select
Range(Cells(2, 3), Cells(a, 3)).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
[d1].Select
End Sub

Ancak A sütununuzdaki veriler sayı değil de metin olarak biçimlendirildiği ve metin içerisinde saniye bilgisi olmadığı için saniyeler hep 0 görünüyor.

 

[EMREKAYA]

Yusuf44 çok teşekkür ederim, elinize sağlık çok güzel olmuş. Doğru haklısınız saniye 00 olarak okuyor, peki bu iki digit için random 2 hane atayabilirmiyiz her satır için?

 

[YUSUF44]

aşağıdaki şekilde dener misiniz?

Sub PDOP()
Dim sayi As Integer
Application.ScreenUpdating = False
a = Cells(Rows.Count, 1).End(3).Row
For i = 2 To a
' Cells(i, 3).FormulaR1C1 = "=TEXT(YEAR(RC[-2]*1),""0000"")&""Y""&TEXT(MONTH(RC[-2]*1),""00"")&""M""&TEXT(DAY(RC[-2]*1),""00"")&""D""&TEXT(HOUR(RC[-2]*1),""00"")&""H""&TEXT(MINUTE(RC[-2]*1),""00"")&""M""&TEXT(SECOND(RC[-2]*1),""00"")&""S"""
Cells(i, 3).FormulaR1C1 = "=TEXT(YEAR(RC[-2]*1),""0000"")&""Y""&TEXT(MONTH(RC[-2]*1),""00"")&""M""&TEXT(DAY(RC[-2]*1),""00"")&""D""&TEXT(HOUR(RC[-2]*1),""00"")&""H""&TEXT(MINUTE(RC[-2]*1),""00"")&""M"""
Randomize
    sayi = Int((99 * Rnd) + 1)
    Cells(i, 3) = Cells(i, 3).Value & Format(sayi, "00") & "S"
Next
Range(Cells(2, 3), Cells(a, 3)).Select
Range(Cells(2, 3), Cells(a, 3)).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
[d1].Select
End Sub

 

[EMREKAYA]

Harika olmuş elinize sağlık.... Random 99 u 60 olarak değiştirdiğimde tam istediğim gibi oldu. Hızlı çözümünüz için teşekkür ederim..

 

[YUSUF44]

O kodun mantığını tam bilmiyorum ancak siz 59 yapın bence. Çünkü 60 saniye olarak ölçüm sonucu alamazsınız. 60 dakika ve 24 saat alamayacağınız gibi.

 

[YUSUF44]

http://www.excel.web.tr/f48/vba-rnd-komutu-random-zellikleri-t125100.html

Bu sayfada rnd komutu anlatılmış. Özellikle 8. mesaj çok güzel anlatmış.