Metin Olarak Saklananları Sayıya Çevirme

ccuneyt13 · 28 Mart 2016

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

ccuneyt13 · 28 Mart 2016

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

ccuneyt13 · 28 Mart 2016

Sayın uzman arkadaşlar desteklerinizi bekliyorum.
Saygılar.

alicimri · 28 Mart 2016

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

ccuneyt13 · 28 Mart 2016

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

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

alicimri · 28 Mart 2016

Yukardaki kodları revize ettim tüm sütunları değiştiriyor. sayı olarak algılaması gerekiyor.

alicimri · 28 Mart 2016

Alttoplam aldığınız hücrenin formatını Genel veya sayı olarak değiştirin

ccuneyt13 · 28 Mart 2016

Üstadım sonuç değişmedi yine metin olarak kaldı.

Sonuç Resmi ektedir.
http://s8.dosya.tc/server2/tls16c/Sonuc.png.html

ccuneyt13 · 28 Mart 2016

Ü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

alicimri · 28 Mart 2016

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

alicimri · 28 Mart 2016

Uyarmayı unutmuşum D9 hücresine 10000 yazın

ccuneyt13 · 29 Mart 2016

Günaydın,
Olmadı malesef,
Sonuç;
#SAYI/0! 0,0000 #SAYI/0! #SAYI/0! #SAYI/0! #SAYI/0!

Yardımlarınızı bekliyorum

excelokyanus500 · 29 Mart 2016

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

ccuneyt13 · 29 Mart 2016

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ş

ccuneyt13 · 29 Mart 2016

Ö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

Korhan Ayhan · 29 Mart 2016

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

ccuneyt13 · 29 Mart 2016

Korhan Ayhan' Alıntı:
Alternatif;

Ü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

" & Son))
satırını;
Set Alan = Union(Range("H2:N" & Son), Range("P2

" & 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?

ccuneyt13 · 29 Mart 2016

Ü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.

Metin Olarak Saklananları Sayıya Çevirme

Administrator