Nokta, Virgül Değiştir

[halit3]

Bu uygulama Nokta ve virgüllerin yer değişimi ile ilgilidir.
Bu kod seçilen bölüm ile ilgili noktaları virgül , Virgülleri nokta yapar.

kod:

Sub noktavirgulduzelt()

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

 

[halit3]

Bu kod seçilen bölüm ile ilgili noktaları virgül yapar.

Sub virgulyap()

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
nokta = "."
virgul = ","

Dim cell As Range

For Each cell In ActiveWindow.RangeSelection.Cells
deg1 = Split(cell.Value, nokta)

hucre = cell.NumberFormat
cell.NumberFormat = "@"
veri = ""
k = 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

Else
cell.Value = cell.Value
End If

Else

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
cell.Value = veri
Else
cell.Value = cell.Value
End If

End If
cell.NumberFormat = hucre
Next

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

End Sub

 

[halit3]

Bu kod seçilen bölüm ile ilgili Virgülleri nokta yapar.

Sub noktayap()

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
deg2 = Split(cell.Value, virgul)
hucre = cell.NumberFormat
cell.NumberFormat = "@"
veri = ""
k = 0
If IsNumeric(cell.Value) = True Then

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

Else

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

End If
cell.NumberFormat = hucre
Next

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

End Sub

 

[1903emre34@gmail.com]

Halit bey, teşekkürler güzel çalışma olmuş

ekte dosyada, seçilen bölüm ilgili olarak noktalar ve virgüller yer değiştirecek şekilde ekleme yapabilirmiyiz

iyi çalışmalar

 

[halit3]

Halit bey, teşekkürler güzel çalışma olmuş

ekte dosyada, seçilen bölüm ilgili olarak noktalar ve virgüller yer değiştirecek şekilde ekleme yapabilirmiyiz

iyi çalışmalar

bunu bir deneyiniz.

Sub noktavirgulduzelt2()

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

deg3 = Split(cell.Value, nokta)
deg4 = Split(cell.Value, virgul)

hucre = cell.NumberFormat
cell.NumberFormat = "@"


If UBound(deg3) > 0 And UBound(deg4) > 0 Then
cell.Value = Replace(Replace(cell.Value, nokta, "#"), virgul, "&")
End If

deg5 = Split(cell.Value, "#")
deg6 = Split(cell.Value, "&")

If UBound(deg5) > 0 And UBound(deg6) > 0 Then
cell.Value = Replace(Replace(cell.Value, "#", virgul), "&", nokta)
End If

cell.NumberFormat = hucre
Next

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

End Sub

 

[1903emre34@gmail.com]

Hocam, çok teşekkürler

Hayırlı günler

 

[halit3]

Bu kod da farklı uygulama

Sub noktavirgulduzelt4()


son = Application.Calculation '-4105
'MsgBox Application.Calculation '-4135

With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With

Dim cell As Range

nokta = "."
virgul = ","

For Each cell In ActiveWindow.RangeSelection.Cells

deg3 = Split(cell.Value, nokta)
deg4 = Split(cell.Value, virgul)

hucre = cell.NumberFormat
If IsDate(cell.Value) = True Then GoTo atla2

cell.NumberFormat = "@"

If UBound(deg3) > 0 And UBound(deg4) > 0 Then

cell.Value = Replace(Replace(cell.Value, nokta, "[#]"), virgul, "[&]")
End If

deg5 = Split(cell.Value, "[#]")
deg6 = Split(cell.Value, "[&]")

If UBound(deg5) > 0 And UBound(deg6) > 0 Then

cell.Value = Replace(Replace(cell.Value, "[#]", virgul), "[&]", nokta)
GoTo atla
End If

If UBound(deg3) > 0 And UBound(deg4) = 0 Then
cell.Value = Replace(cell.Value, nokta, virgul)
If IsNumeric(cell.Value) = True Then
cell.Value = cell.Value * 1
End If
GoTo atla
End If

If UBound(deg4) > 0 And UBound(deg3) <= 0 Then
cell.Value = Replace(cell.Value, virgul, nokta)
GoTo atla
End If

atla2:
 
If IsDate(cell.Value) = True Then
cell.Value = Replace(Replace(cell.Value, nokta, "[#]"), virgul, "[&]")
cell.Value = Replace(Replace(cell.Value, "[#]", virgul), "[&]", nokta)
End If

atla:
cell.NumberFormat = hucre
Next

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


End Sub

 

[EthemX]

Merhaba halit bey, ben butona tıklayınca belli bir bölümdeki "," (virgül) lerin, "." (nokta) ile "." (nokta) ların da "," (virgül) ile değişmesini istiyorum, aşağıdaki kodu denedim ama, aynı anda yaptıramadığım için amacıma ulaşamadım.

Sub Düğme1_Tıkla()
Dim sayac, c As Integer
Dim primtutari As String

sayac = [Sayfa1!A1].CurrentRegion.Rows.Count
MsgBox sayac

For c = 1 To sayac Step 1
primtutari = Range("L" & c).Value
Range("L" & c).Value = Replace(Replace(primtutari, ".", ","), ".", ",")
Next
End Sub

 

[askm]

Aşağıdaki şekilde deneyebilir misiniz?

Sub Düğme1_Tıkla()
Dim sayac, c As Integer
Dim primtutari As String

sayac = [Sayfa1!A1].CurrentRegion.Rows.Count
'MsgBox sayac

For c = 1 To sayac Step 1
'primtutari = Range("L" & c).Value
Range("L" & c).Value = Replace(Range("L" & c).Value, ".", "-")
Range("L" & c).Value = Replace(Range("L" & c).Value, ",", ".")
Range("L" & c).Value = Replace(Range("L" & c).Value, "-", ",")
Next
End Sub

 

[EthemX]

Evet oldu teşekkürler, bende şöyle birşey yapıp sorunu çözdüm aslında posttan sonra;

Range("L" & c).Value = Replace(Replace(primtutari, ",", ""), ".", ",")

virgülü kaldırıp, noktayı değiştirerek. Yani örneği; 17,572.00 sayısını, 17572,00 yaptı.

 

[halit3]

Merhaba halit bey, ben butona tıklayınca belli bir bölümdeki "," (virgül) lerin, "." (nokta) ile "." (nokta) ların da "," (virgül) ile değişmesini istiyorum, aşağıdaki kodu denedim ama, aynı anda yaptıramadığım için amacıma ulaşamadım.

Sub Düğme1_Tıkla()
Dim sayac, c As Integer
Dim primtutari As String

sayac = [Sayfa1!A1].CurrentRegion.Rows.Count
MsgBox sayac

For c = 1 To sayac Step 1
primtutari = Range("L" & c).Value
Range("L" & c).Value = Replace(Replace(primtutari, ".", ","), ".", ",")
Next
End Sub

7 nolu mesajdaki kod bu işlemi yapıyor seçili alanı kod birinci tıklamada farklı ikinci tıklamada farklı işlem yapıyor