Vba Virgül Temizleme

[Keremcelik34]

Merhaba arkadaşlar,

4,090,55 gibi satırdaki solda eğer virgül var ise virgül ü silecek makro ya ihtiyacım var yani 4090,55 e çevirmesini istiyorum ama eğer virgül var ise.

Teşekkürler.

 

[suleyman242]

Private Sub CommandButton1_Click()
On Error Resume Next
Range("B:B").ClearContents
    For x = 1 To [a65536].End(3).Row
            dad = Cells(x, "A").Value
            ayir = Split(dad, ",")
            Cells(x, "B").Value = ayir(0)
            Cells(x, "B").Value = ayir(0) & "," & ayir(1)
            Cells(x, "B").Value = ayir(0) & ayir(1) & "," & ayir(2)
    Next
End Sub

 

[Keremcelik34]

Private Sub CommandButton1_Click()
On Error Resume Next
Range("B:B").ClearContents
    For x = 1 To [a65536].End(3).Row
            dad = Cells(x, "A").Value
            ayir = Split(dad, ",")
            Cells(x, "B").Value = ayir(0)
            Cells(x, "B").Value = ayir(0) & "," & ayir(1)
            Cells(x, "B").Value = ayir(0) & ayir(1) & "," & ayir(2)
    Next
End Sub

Eyvallah saolasın müdür çok işime yaradı.

 

[Korhan Ayhan]

Alternatif kod;

Sub VIRGUL_TEMIZLE()
    Dim X As Long, Say As Byte, Y As Byte, Veri As String
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        Say = Len(Cells(X, 1)) - Len(Replace(Cells(X, 1), ",", ""))
        If Say > 1 Then
            For Y = 1 To Say - 1
                If Veri = "" Then
                    Veri = WorksheetFunction.Substitute(Cells(X, 1), ",", "", 1)
                Else
                    Veri = WorksheetFunction.Substitute(Veri, ",", "", 1)
                End If
            Next
            Cells(X, 1) = CDbl(Veri)
            Veri = ""
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Keremcelik34]

Korhan modum alternatif içinde teşekkürler.

 

[suleyman242]

Eyvallah saolasın müdür çok işime yaradı.

Benim için pembe bir hayal galiba ama yinede saolasın.

 

[Necdet]

Merhaba,

Bende Süleyman Bey gibi split ile çözdüm. Alternatif olsun. Verilerin A sütununda olduğu varsayılarak yine A sütununda düzenler.

Kodların bir modülde olması gerekir.

Sub Duzelt()
    
    Dim i   As Long, _
        j   As Integer, _
        d, _
        k
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        k = ""
        d = Split(Cells(i, "A"), ",")
        If UBound(d) > 0 Then
            For j = 0 To UBound(d) - 1
                k = k & d(j)
            Next j
            k = k & "," & d(UBound(d))
            Cells(i, "A") = CDbl(k)
        End If
    Next i
    
End Sub