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

baydeniro · 1 Mayıs 2020

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 · 1 Mayıs 2020

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

Kod:

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 · 1 Mayıs 2020

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 · 1 Mayıs 2020

numan şamil' Alıntı:
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 · 1 Mayıs 2020

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

baydeniro · 1 Mayıs 2020

numan şamil' Alıntı:
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 · 1 Mayıs 2020

baydeniro' Alıntı:
teşekkürler üstad, tekrar deneyeyim.

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

baydeniro · 1 Mayıs 2020

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

metin_0606 · 1 Mayıs 2020

baydeniro' Alıntı:
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 · 1 Mayıs 2020

baydeniro' Alıntı:
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 · 1 Mayıs 2020

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 · 1 Mayıs 2020

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

baydeniro · 1 Mayıs 2020

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

leguminosea · 1 Mayıs 2020

Alternatif olsun.

Kod:

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 · 1 Mayıs 2020

Deneyiniz. Ben olumlu sonuç aldım.

C++:

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 · 1 Mayıs 2020

Alternatif :

Kod:

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

baydeniro · 1 Mayıs 2020

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

baydeniro · 1 Mayıs 2020

Korhan Ayhan' Alıntı:

Deneyiniz. Ben olumlu sonuç aldım.

C++:

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 · 1 Mayıs 2020

Seyit Tiken' Alıntı:
Alternatif :

Kod:

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

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

baydeniro

numan şamil

Destek Ekibi

Korhan Ayhan

Administrator

baydeniro

numan şamil

Destek Ekibi

baydeniro

metin_0606

baydeniro

metin_0606

metin_0606

baydeniro

Korhan Ayhan

Administrator

baydeniro

Ekli dosyalar

leguminosea

Korhan Ayhan

Administrator

Seyit Tiken

Uzman

baydeniro

baydeniro

baydeniro