• DİKKAT

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

Metin Olarak Saklananları Sayıya Çevirme

C

ccuneyt13

Altın Üye
Katılım
20 Ocak 2011
Mesajlar
478
Excel Vers. ve Dili
Office 365 Türkçe (64 bit)
Arkadaşlar Merhaba,

Ekte yer alan dosyada 46.2000 - 117.0000 - 6.5000 gibi metin olarak görünen sayılar var. Amacım bunları 46,20 - 117,00 - 6,50 olarak makro ile sayıya çevirmek.

Öncelikle makrosuz olarak H sütunu ile M sütunlarını seçtim. Biçimlendirmeden Sayı formatı yaptım, Değiştir ile "." ları "," ile değiştirdim. İstediğim sonucu aldım.

Ancak aynı işlemleri makro kaydederek yapıp çalıştırdığımda rakamları 462.000,00 - 1.170.000,00 - 65.000,00 olarak değiştirdi.

Makro Kaydet ile aldığım kodlar bunlardır.
Kod: 
Sub Makro1()
'
' Makro1 Makro
'

'
    Columns("H:N").Select
    Range("H2").Activate
    Selection.NumberFormat = "#,##0.00"
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
End Sub

Birde aşağıdaki gibi bir kod buldum ve çalıştırdım. Bu kod tam istediğim gibi çeviriyor ancak buda her şeyi (istemediğim sütunları da) çeviriyor.

Kod: 
Sub ConvertTextNumberToNumber()
For Each WS In Sheets
On Error Resume Next
For Each r In WS.UsedRange.SpecialCells(xlCellTypeConstants)
If IsNumeric(r) Then r.Value = Val(r.Value)
Next
Next
End Sub

Sizden ricam ek dosyada üst örnekte sarı renkli sütunları alttaki gibi sayıya dönüştürmek. Yada 2. kodu sadece istediğim sütunlara uygulamak için kodda değişiklik.

Yardım ve destekleriniz için şimdiden teşekkürlerimi sunuyorum.

Saygılarımla.

Örnek Dosya:
http://s6.dosya.tc/server6/nsy874/Ornek1.xlsx.html
 
Son düzenleme:
Sayın Uzman arkadaşlar,

Aşağıda yeni bir kod ile h2 ile h14 arası için yapmak istediğime ulaşıyorum.

Sizden ricam aşağıdaki kodu h2 den başlayıp, h2 en son dolu hücreye kadar çalışması için, kodu güncelleme me yardımcı olabilir misiniz.

Teşekkürler.

Kod: 
Sub Converter()
    Dim rBig As Range, r As Range, v As Variant
    Set rBig = Range[B][COLOR="Red"]("h2:h14")[/COLOR][/B]
    For Each r In rBig
        v = r.Value
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                End If
            End If
        End If
    Next r
End Sub
 
Sayın uzman arkadaşlar desteklerinizi bekliyorum.
Saygılar.
 
Eğer noktadan sonra dört hane sabitse
Kod: 
Sub ss()
say = Range("h65536").End(3).Row
For i = 1 To Range("H2:M" & say).Count
If IsNumeric(Range("H2:M" & say)(i)) Then
Range("H2:M" & say)(i).Value = Format(Replace(Range("H2:M" & say)(i).Value, ".", "") / 10000, "#,##0.00")
End If
Next
End Sub
 
Son düzenleme:
alicimri' Alıntı:
Eğer noktadan sonra dört hane sabitse
Sub Converter()
For i = 2 To Range("h65536").End(3).Row
If IsNumeric(Range("H" & i)) Then
Range("H" & i).Value = Format(Replace(Range("H" & i).Value, ".", "") / 10000, "#,##0.00")
End If
Next
End Sub
Genişletmek için tıkla ...

Ali bey ilginize teşekkür ederim.
Verdiğiniz kodu denedim, görünümü 2 tam 2 kesir olarak yaptı ancak halen metin olarak gösteriyor. alt toplam vs alamıyorum yine :(
 
Yukardaki kodları revize ettim tüm sütunları değiştiriyor. sayı olarak algılaması gerekiyor.
 
Alttoplam aldığınız hücrenin formatını Genel veya sayı olarak değiştirin
 
Üstadım 2. nolu mesajındaki kodda yer alan
Set rBig = Range("h2:h14") satırı h:h yaparsam da oluyor ancak tüm H sütununu yapmaya çalıştığı için kasıyor.
Orjinal tablom 50-60 bin satırdan oluşuyor.

Şu şekilde yapmaya çalışıyorum;
Set rBig = Range("h2").End(3).Row bu seferde "Type Mismatch" hatası veriyor :S

Velhasıl 2 nolu mesajdaki kodu H sütünundaki son dolu hücreye kadar döngü olacak şekilde yapsak olur mu acaba diye düşünüyorum
 
Birde aşağıdaki kodu deneyin
Kod: 
Sub Makro1()
say = Range("h65536").End(3).Row
    Range("H2:N" & say).Select
    Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D9").Copy
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.00"
    Selection.HorizontalAlignment = xlRight
End Sub
 
Uyarmayı unutmuşum D9 hücresine 10000 yazın
 
Günaydın,
Olmadı malesef,
Sonuç;
#SAYI/0! 0,0000 #SAYI/0! #SAYI/0! #SAYI/0! #SAYI/0!


Yardımlarınızı bekliyorum :(
 
Son düzenleme:
Deneyin

Sub rakamyap()
On Error Resume Next
Dim rakam As Object, i%
Set rakam = CreateObject("VBScript.RegExp")
rakam.Global = True
rakam.Pattern = "[0-9]{0,15}[.]{1}[0-9]{2}"
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 1 To Range("H65536").End(3).Row

Cells(i, "I") = rakam.Execute(Cells(i, "H")).Item(0) * 1
Next i
Set rakam = Nothing
End Sub
 

Verdiğiniz kod sadece I sütununu çevirdi ve 46.2000 - 4620 olarak çevirdi.

Yinede çok teşekkürler.

Bir kodu deniyorum bitirmek üzereyim. Ne sinir bozucu bir iş :)
 
Örnek tabloya ek olarak bir kaç sütunu daha sayıya çevirecek şekilde ve sadece son dolu hücreye kadar çalışacak şekilde döngü kurmayı başardım sanırım :)
Kendi sorumu kendim cevaplamakta garip oldu :)
İlgilenen tüm arkadaşlara teşekkür ediyorum.
Belki lazım olur diye uyarladığım kodu paylaşıyorum.
Saygılar.
Kod: 
Sub Converter()
    Dim rBig As Range, r As Range, v As Variant
    Set rBig = Range("h:n")
    For Each r In rBig
    Application.ScreenUpdating = False
        v = r.Value
        If v = "" Then
        GoTo 1
        Else
        End If
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                  
                    End If
                End If
   
   End If
   Next r
 

1    Set rBig = Range("p:p")
     For Each r In rBig
    
        v = r.Value
        If v = "" Then
        GoTo 2
        Else
        End If
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                  
                    End If
                End If
            End If
    Next r

2       Set rBig = Range("t:t")
        For Each r In rBig
    
        v = r.Value
        If v = "" Then
        GoTo 3
        Else
        End If
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                  
                    End If
                End If
            End If
    Next r

    
    
3     Set rBig = Range("ag:aı")
        For Each r In rBig
    
        v = r.Value
        If v = "" Then
        Exit Sub
        Else
        End If
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                  
                    End If
                End If
            End If
    Next r
End Sub
 
Alternatif;

Kod: 
Sub SAYIYA_ÇEVİR()
    Dim Alan As Range, Veri As Range, Son As Long, Data As Variant
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Set Alan = Union(Range("H2:N" & Son), Range("P2:P" & Son))
    
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If IsNumeric(Veri.Value) Then
                Data = CDbl(Replace(Veri.Value, ".", ","))
                Veri.ClearContents
                Veri.ClearFormats
                Veri.NumberFormat = "#,##0.00"
                If Veri.Column = 16 Then Veri.NumberFormat = "###0"
                Veri.Value = Data
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Alternatif;
Genişletmek için tıkla ...

Üstadım harika çalışıyor,
Elinize sağlık..
Bir hususta bilgi verebilirseniz de çok memnun olurum;
Sizin koddaki
Set Alan = Union(Range("H2:N" & Son), Range("P2:P" & Son))
satırını;
Set Alan = Union(Range("H2:N" & Son), Range("P2:P" & Son), Range("t2:t" & Son))
şeklinde uzattım şöyle bir durum oldu.

Sizin kod ile P sütununun değerlerini istediğim gibi "###0" yapıyor ama benim eklediği T sütununun formatı neden #.##0,00 oldu acaba?

If Veri.Column = 16 Then Veri.NumberFormat = "###0"
bu kod sanırım o işe yarıyor ama, T de 16 dan sonra ama acaba neden #.##0,00 formatında getir di?
 
Üstadım,
Kodu,
If Veri.Column >= 16 Then Veri.NumberFormat = "###0"
değiştirerek yaptım süper oldu.
Tekrar çok teşekkür ederim.
Ellerinize sağlık.

excelokyanus500
alicimri
Arkadaşlar sizlere de çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst