Virgülleri Noktaya Dönüştürmek

[baydeniro]

Merhaba Arkadaşlar,
Aralıktaki virgülleri noktaya çevirmek istiyorum. Makroyu hazırlarken çalışıyor ma bitmiş makroyu çalıştırınca dönüşmüyor. Buna çare var mıdır ?

Not : Paylaşım yaparken Markro kodlarını kod formunda yazmak için ne yapmak lazım ? nasıl yazdıysam olmadı
Code
Sub DEGISTIR()
Range("A1:A1000").Select
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

 

[numan şamil]

Merhaba
Halit 3 Hocamın kodları belki işini görür
noktaları virgül, virgülleri nokta yapıyor

Sub noktavirgulduzelt()

Range("A1:A1000").Select

With Application

CalcMode = .Calculation

.Calculation = xlCalculationManual

.ScreenUpdating = False

.EnableEvents = False

End With

Dim cell As Range

nokta = "."

virgul = ","

For Each cell In ActiveWindow.RangeSelection.Cells

deg1 = Split(cell.Value, nokta)

deg2 = Split(cell.Value, virgul)

hucre = cell.NumberFormat

cell.NumberFormat = "@"

veri = ""

k = 0

kk = 0

If IsNumeric(cell.Value) = True Then

If UBound(deg1) > 0 Then

For i = 0 To Val(UBound(deg1))

k = k + 1

If k = 1 Then

veri = deg1(i)

Else

veri = veri & virgul & deg1(i)

End If

Next

If UBound(deg1) = 1 Then

cell.Value = veri * 1

Else

cell.Value = veri

End If

ElseIf UBound(deg2) > 0 Then

For i = 0 To Val(UBound(deg2))

kk = kk + 1

If kk = 1 Then

veri = deg2(i)

Else

veri = veri & nokta & deg2(i)

End If

Next

cell.Value = veri

Else

cell.Value = veri

End If

Else

If UBound(deg1) Then

For i = 0 To Val(UBound(deg1))

k = k + 1

If k = 1 Then

veri = deg1(i)

Else

veri = veri & virgul & deg1(i)

End If

Next

cell.Value = veri

End If

If UBound(deg2) Then

For i = 0 To Val(UBound(deg2))

kk = kk + 1

If kk = 1 Then

veri = deg2(i)

Else

veri = veri & nokta & deg2(i)

End If

Next

cell.Value = veri

End If

cell.Value = cell.Value

End If

cell.NumberFormat = hucre

Next

With Application

.ScreenUpdating = True

.EnableEvents = True

.Calculation = CalcMode

End With

End Sub

 

[Korhan Ayhan]

Mesaj yazılan pencerede bulunan üç nokta menüsüne tıklayıp kodlarınızı foruma ekleyebilirsiniz.



Diyelim ki menüden </>Kod yazan seçeneği seçtiniz. Karşınıza aşağıdaki ekran gelecektir. Dilerseniz DİL bölümünden seçim yaparak paylaştığınız kod diline göre seçim yapabilirsiniz.

 

[baydeniro]

Merhaba
Halit 3 Hocamın kodları belki işini görür
noktaları virgül, virgülleri nokta yapıyor
Sub noktavirgulduzelt()
Range("A1:A1000").Select
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Dim cell As Range

nokta = "."
virgul = ","

For Each cell In ActiveWindow.RangeSelection.Cells



deg1 = Split(cell.Value, nokta)
deg2 = Split(cell.Value, virgul)

hucre = cell.NumberFormat
cell.NumberFormat = "@"
veri = ""
k = 0
kk = 0
If IsNumeric(cell.Value) = True Then
If UBound(deg1) > 0 Then
For i = 0 To Val(UBound(deg1))
k = k + 1
If k = 1 Then
veri = deg1(i)
Else
veri = veri & virgul & deg1(i)
End If
Next

If UBound(deg1) = 1 Then
cell.Value = veri * 1
Else
cell.Value = veri
End If

ElseIf UBound(deg2) > 0 Then

For i = 0 To Val(UBound(deg2))
kk = kk + 1
If kk = 1 Then
veri = deg2(i)
Else
veri = veri & nokta & deg2(i)
End If
Next
cell.Value = veri
Else
cell.Value = veri
End If

Else

If UBound(deg1) Then
For i = 0 To Val(UBound(deg1))
k = k + 1
If k = 1 Then
veri = deg1(i)
Else
veri = veri & virgul & deg1(i)
End If
Next
cell.Value = veri
End If

If UBound(deg2) Then
For i = 0 To Val(UBound(deg2))
kk = kk + 1
If kk = 1 Then
veri = deg2(i)
Else
veri = veri & nokta & deg2(i)
End If
Next
cell.Value = veri
End If

cell.Value = cell.Value

End If
cell.NumberFormat = hucre
Next

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

End Sub

Numan şamil üstadım desteğin için teşekkür ediyorum. Kodu uygulamadım. Ama çalışması çok uzun sürüyor ve 5 dakikadır bitmedi. Daha kısa bir yöntem olabilir mi !

 

[numan şamil]

Ben bilgiayarımda 3000 satıra uyguladım 5-6 sn sürdü
sizin veriler kaç satırlık

 

[baydeniro]

Ben bilgiayarımda 3000 satıra uyguladım 5-6 sn sürdü
sizin veriler kaç satırlık

teşekkürler üstad, tekrar deneyeyim.

 

[metin_0606]

teşekkürler üstad, tekrar deneyeyim.

verileri seçerken sadece dolu satırları seçiniz boş olanlarıda seçerseniz işleminiz uzar

 

[baydeniro]

Sayılardaki virgülü noktaya veya başka bir karaktere çevirmek mümkün mü ?

 

[metin_0606]

Sayılardaki virgülü noktaya veya başka bir karaktere çevirmek mümkün mü ?

Paylaşılan makro sayılardaki virgülü noktaya çeviriyor zaten

 

[metin_0606]

Sayılardaki virgülü noktaya veya başka bir karaktere çevirmek mümkün mü ?

Paylaşılan makrodaki bu iki satırdaki karakterlerle oynayarak istediğiniz değişikliği yapabilirsiniz


nokta = "."

virgul = ","

 

[baydeniro]

bu kod herhalde beni poek sevmedi
800 satırda 10 dakikadır dönüp duruyor
ayrıca virgülleri nokta yapmadı
eminim sizde çalışıyordur ama daha pratik bir çözüm olsa daha iyi olur

 

[Korhan Ayhan]

Bütün sorunun kaynağı örnek dosya olmaması...

 

[baydeniro]

Korhan Ayhan üstadım. Örnek dosya yükledim. İlginize şimdiden çok teşekkürler

 

[leguminosea]

Alternatif olsun.

Sub Nokta()
Dim a As Range
For Each a In Sheets("Sayfa1").Range("A1:A1000")
a.NumberFormat = "@"
a = Replace(a.Value, ",", ".")
a.NumberFormat = "General"
Next
End Sub

 

[Korhan Ayhan]

Deneyiniz. Ben olumlu sonuç aldım.

Sub Test()
    With Range("A:A")
        .TextToColumns Destination:=.Cells(1, 1), FieldInfo:=Array(1, 2)
        .NumberFormat = "@"
        .Replace ",", " "
        .Replace " ", "."
        .TextToColumns Destination:=.Cells(1, 1), FieldInfo:=Array(1, 2)
    End With
End Sub

 

[Seyit Tiken]

Alternatif :

Sub noktayacevir()
With Application
.DecimalSeparator = "."
.UseSystemSeparators = False
End With
End Sub

 

[baydeniro]

Teşekkürler üstad leguminosea, elinize sağlık. sağlıcakla kalın

 

[baydeniro]

Deneyiniz. Ben olumlu sonuç aldım.

Sub Test()
    With Range("A:A")
        .TextToColumns Destination:=.Cells(1, 1), FieldInfo:=Array(1, 2)
        .NumberFormat = "@"
        .Replace ",", " "
        .Replace " ", "."
        .TextToColumns Destination:=.Cells(1, 1), FieldInfo:=Array(1, 2)
    End With
End Sub

Üstad mükemmel bir kod, çok çok teşekkür ediyorum, sağlıcakla kaln

 

[baydeniro]

Alternatif :

Sub noktayacevir()
With Application
.DecimalSeparator = "."
.UseSystemSeparators = False
End With
End Sub

Seyit Tiken üstadım harika bir kod, çok çok teşekkür ediyorum, sağlıcakla kalın