• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

metin içine rakam eklemek

M

mersilen

Destek Ekibi
Destek Ekibi
Katılım
31 Aralık 2009
Mesajlar
1,105
Excel Vers. ve Dili
excel 2007 türkçe
Excel Vers. ve Dili Ofis 2003
Selamlar
aşağıdaki verilerde ikinci noktalama işaretinden sonra tek rakam varsa önüne 0 eklemek istiyorum

02:464:11
12:465:5
02:84:10
02:84:3
02:84:4
02:84:5
02:84:6
02:84:7

sonrası aşağıdaki gibi olmalı

02:464:11
12:465:05
02:84:10
02:84:03
02:84:04
02:84:05
02:84:06
02:84:07
 

Ekli dosyalar

Merhaba,

Kod: 
=EĞER(SOLDAN(SAĞDAN(D2;2);1)=":";YERİNEKOY(D2;":";":0";2);D2)
Bu şekilde deneyiniz.

.
 
sağdan, soldan :)
güzel bir yorum kendi adıma teşekkür ederim
 
Ömer hocam yine döktürmüşsünüz valla , sorunsuz çalışıyor
çözüm için teşekkürler

tablomda çok fazla formüller olduğundan exceli bazen kastırıyor
bu yüzden olayı macroyla çözüyüm dedim ama biryerlerde takıldım
macroyu değerlendirebilir miyiz?

Kod: 
Sub Makro5sonson1()
'
' Makro5sonson Makro
'
Dim x, c10, d10, e10, f11 As Integer
'c10=YERİNEKOY(B10;"Rohstoffe auf ";"")
  '  d10=EĞER((YERİNEKOY(C10;" (Planet)";"")=C10);(YERİNEKOY(C10;" (Raumstation)";""));(YERİNEKOY(C10;" (Planet)";"")))
    '    e10=EĞER(BUL(":";D10)<3;BİRLEŞTİR(0;D10);D10)
       '     f10=EĞER(SOLDAN(SAĞDAN(E10;2);1)=":";YERİNEKOY(E10;":";":0";2);E10)


'
For x = 10 To 36
   ' Range("B10").Select = "Rohstoffe auf 14:404:1 (Planet)"
   
    b10 = Range("b" & x).Value
     [COLOR="Red"]c10= worksheetfunction.SUBSTITUTE(b10,""Rohstoffe auf "","""")"[/COLOR]
    
    'ActiveCell.FormulaR1C1 = "1=EĞER((YERİNEKOY(C10;"" (Planet)"";"""")=C10);(YERİNEKOY(C10;"" (Raumstation)"";""""));(YERİNEKOY(C10;"" (Planet)"";"""")))"
   
    [COLOR="Red"]d10 = worksheetfunction.IF((SUBSTITUTE(c10,"" (Planet)"","""")=c10),(SUBSTITUTE(c10,"" (Raumstation)"","""")),(SUBSTITUTE(c10,"" (Planet)"","""")))"[/COLOR]
    
    'ActiveCell.FormulaR1C1 = "1=EĞER(BUL("":"";D10)<3;BİRLEŞTİR(0;D10);D10)"
    
     [COLOR="Red"]e10 = worksheetfunction.IF(FIND("":"",d10)<3,CONCATENATE(0,d10),d10)"[/COLOR]
    
    'ActiveCell.FormulaR1C1 ="1=EĞER(SOLDAN(SAĞDAN(E10;2);1)="":"";YERİNEKOY(E10;"":"";"":0"";2);E10)"
    
    [COLOR="Red"]f10 = worksheetfunction.F(LEFT(e10,2),1)="":"",SUBSTITUTE(e10,"":"","":0"",2),e10)"[/COLOR]
    Range("g" & x).Value = f10
    
    
Next x

End Sub

sonradan kodları aşağıdaki ile düzelttim ama yine çalışmadı
Kod: 
Sub macrode()
Dim x, c10, d10, e10, f11 As Integer
'c10=YERİNEKOY(B10;"Rohstoffe auf ";"")
  '  d10=EĞER((YERİNEKOY(C10;" (Planet)";"")=C10);(YERİNEKOY(C10;" (Raumstation)";""));(YERİNEKOY(C10;" (Planet)";"")))
    '    e10=EĞER(BUL(":";D10)<3;BİRLEŞTİR(0;D10);D10)
       '     f10=EĞER(SOLDAN(SAĞDAN(E10;2);1)=":";YERİNEKOY(E10;":";":0";2);E10)'
       '
For x = 10 To 32
   ' Range("B10").Select = "Rohstoffe auf 14:404:1 (Planet)"
   
    b10 = Range("b" & x).Value
    c10 = WorksheetFunction.Substitute(b10, "Rohstoffe auf ", "")
    
    'ActiveCell.FormulaR1C1 = "1=EĞER((YERİNEKOY(C10;"" (Planet)"";"""")=C10);(YERİNEKOY(C10;"" (Raumstation)"";""""));(YERİNEKOY(C10;"" (Planet)"";"""")))"
    d10 = WorksheetFunction.IF((Substitute(c10, " (Planet)", "") = c10), (Substitute(c10, " (Raumstation)", "")), (Substitute(c10, " (Planet)", "")))
    
    'ActiveCell.FormulaR1C1 = "1=EĞER(BUL("":"";D10)<3;BİRLEŞTİR(0;D10);D10)"
    e10 = WorksheetFunction.IF(Find(":", d10) < 3, CONCATENATE(0, d10), d10)
    
    'ActiveCell.FormulaR1C1 ="1=EĞER(SOLDAN(SAĞDAN(E10;2);1)="":"";YERİNEKOY(E10;"":"";"":0"";2);E10)"
    f10 = WorksheetFunction.IF(Left(Right(e10, 2), 1) = ":", Substitute(e10, ":", ":0", 2), e10)
    
    Range("g" & x).Value = f10
Next x
End Sub
 

Ekli dosyalar

Son düzenleme:
Bu şekilde deneyiniz.

Kod: 
Sub NoktaDuzenle()
 
    Dim i As Long, deg As String
    Dim oprt() As String
 
    On Error GoTo atla
    With Range("G10:G" & Rows.Count)
        .NumberFormat = "@"
        .ClearContents
    End With
 
    For i = 10 To Cells(Rows.Count, "D").End(xlUp).Row
        With Cells(i, "D")
            If .Value <> "" Then
                oprt = Split(Cells(i, "D"), ":")
                deg = oprt(UBound(oprt))
                If Len(deg) = 1 Then
                    Cells(i, "G") = Application.Substitute(.Value, ":", ":0", 2)
                Else
                    Cells(i, "G") = .Value
                End If
            End If
        End With
    Next i
 
    Exit Sub
atla:
 
End Sub
.
 
Ömer bey cevap için teşekkürler
kod çalışıyor, yalnız ara sütundaki değeri kaynak olarak kullanıyor

benim yazmaya çalıştığım kodda ilk kaynak sütun olan B sütunundan sayıları alıp düzenleme yapmaya çalışıyorum
örneğin
b2= Rohstoffe auf 5:250:3 (Planet)
alıp
g2= 05:250:03
yazdırmaya çalışıyorum
4.mesajımda yapmaya çalıştığım buydu.
 
Bu şekilde deneyiniz.

Kod: 
Sub NoktaDuzenle()
 
    Dim i As Long, deg As String, veri As String
    Dim oprt() As String
    Dim Wf As WorksheetFunction
    
    Set Wf = WorksheetFunction
    
    On Error GoTo atla
    
    With Range("G10:G" & Rows.Count)
        .NumberFormat = "@"
        .ClearContents
    End With
    
    For i = 10 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(i, "B") <> "" Then
        veri = Wf.Substitute(Wf.Substitute(Cells(i, "B"), "Rohstoffe auf ", ""), " (Planet)", "")
            oprt = Split(veri, ":")
            deg = oprt(UBound(oprt))
            If Len(deg) = 1 Then
                Cells(i, "G") = Wf.Substitute(veri, ":", ":0", 2)
            Else
                Cells(i, "G") = veri
            End If
        End If
    Next i
    
    Exit Sub
    
atla:
End Sub

.
 
Ömer bey tekrar teşekkür ederim kodlar sorunsuz çalışıyor

kodları biraz kendime göre adapte ettim
ancak 5:250:3 gibi bir değerde son iki haneyi (5:250:03) sizin sayenizde düzeldi
ben baştaki tek haneyide 2 haneli (05:250:03) yapmak istiyorum,sıralamada sorun oluyor yoksa
formülle bunu çok kısa bir yolla çözebiliyorum
Kod: 
=EĞER(BUL("":"";D10)<3;BİRLEŞTİR(0;D10);D10)
ancak macrosunda hata oluyor


Kod: 
 'ActiveCell.FormulaR1C1 = "=EĞER(BUL("":"";D10)<3;BİRLEŞTİR(0;D10);D10)"
 'e10 = WorksheetFunction.If(Find(":", d10) < 3, CONCATENATE(0, d10), d10)
 [COLOR="Red"]veri = Wf.If(Wf.Find(":", veri) < 3, Wf.CONCATENATE(0, veri), veri)[/COLOR]
 'veri = Wf.If(Wf.Find(":", veri) < 3, [COLOR="Red"]"0" & veri[/COLOR], veri)
sanırım formüldeki birleştir in karşılığı macroda concatenate olarak gözüküyor,
wf.concatenate macroda çalışmıyor, bende "0" & veri yoluyla çözmeye çalıştım yinede olmadı
Kod:
Kod:



Kod: 
Sub NoktaDuzenle8()
 
    Dim i As Long, deg As String, veri As String, verim As String
    Dim oprt() As String
    Dim Wf As WorksheetFunction
    
    Set Wf = WorksheetFunction
    
    On Error GoTo atla
    
    With Range("G10:G" & Rows.Count)
        .NumberFormat = "@"
        .ClearContents
    End With
    
    For i = 10 To Cells(Rows.Count, "B").End(xlUp).Row
   
   
        If Cells(i, "B") <> "" Then
        veri = Wf.Substitute(Cells(i, "B"), " (Raumstation)", "")
        veri = Wf.Substitute(Wf.Substitute(veri, "Rohstoffe auf ", ""), " (Planet)", "")
        
      [COLOR="SeaGreen"]  'ActiveCell.FormulaR1C1 = "=EĞER(BUL("":"";D10)<3;BİRLEŞTİR(0;D10);D10)"
        'e10 = WorksheetFunction.If(Find(":", d10) < 3, CONCATENATE(0, d10), d10)[/COLOR]
         [COLOR="Red"]veri = Wf.If(Wf.Find(":", veri) < 3, Wf.CONCATENATE(0, veri), veri)[/COLOR]
        [COLOR="SeaGreen"]'veri = Wf.If(Wf.Find(":", veri) < 3, [COLOR="Red"]"0" & veri[/COLOR], veri)[/COLOR]
            
            oprt = Split(veri, ":")
            deg = oprt(UBound(oprt))
            If Len(deg) = 1 Then
                Cells(i, "G") = Wf.Substitute(veri, ":", ":0", 2)
            Else
                Cells(i, "G") = veri
            End If
        End If
    Next i
    
    Exit Sub
    
atla:
End Sub
 
Hücre formatı her koşulda;

00:000:00

bu mu olmalı?

.
 
mersilen' Alıntı:
Kusura bakmayın geri dönmem geç oluyor, işler yoğun
Tümünün formatı sizin dediğiniz gibi olacak
00:000:00
Genişletmek için tıkla ...

Bu şekilde deneyiniz.

Kod: 
Sub NoktaDuzenle()
 
    Dim i As Long, veri As String
    Dim Wf As WorksheetFunction
 
    Set Wf = WorksheetFunction
 
    On Error GoTo atla
 
    With Range("G10:G" & Rows.Count)
        .NumberFormat = "@"
        .ClearContents
    End With
 
    For i = 10 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(i, "B") <> "" Then
            veri = Wf.Substitute(Split(Cells(i, "B"), "(")(0), _
                                    "Rohstoffe auf ", "")
            Cells(i, "G") = Format(Split(veri, ":")(0), "00") _
                        & ":" & Format(Split(veri, ":")(1), "000") _
                        & ":" & Format(Split(veri, ":")(2), "00")
        End If
    Next i
 
    Exit Sub
atla:
 
End Sub
.
 
ömer bey teşekkürler
tam istediğim gibi çalışıyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst