Hücre içindeki rakamları kısaltma

[steppe]

Merhaba Arkadaşlar,

40.98229658742376, 28.707264510734888 şeklinde rakamları noktanın sağında 6 rakam kalacak şekilde makro ile nasıl kısaltabilirim? örnek: Yukarıdaki sayıyı 40.982296, 28.707268 yapma not:Regexp Pattern ile yapmaya çalıştım beceremedim.

 

[ÖmerFaruk]

Formülle çözüm ararsanız
=SOLDAN(A1;MBUL(".";A1;1)) & PARÇAAL(A1;MBUL(".";A1;1)+1;6) &", " &PARÇAAL(A1;MBUL(",";A1;1)+2;MBUL(".";A1;MBUL(",";A1;1))-MBUL(",";A1;1)-1)&PARÇAAL(A1;MBUL(".";A1;MBUL(",";A1;1))+1;6)

 

[steppe]

NextLevel Hocam,
İlginiz için çok teşekkür ederim. Yalnız makro ile olursa çok iyi olur.

 

[ÖmerFaruk]

Sub RakamlarıKısalt()
    XX = Range("A1")
    x1 = Left(XX, InStr(1, XX, ".") + 6)
    x2 = Mid(XX, InStr(1, XX, ",") + 2, InStr(InStr(1, XX, ","), XX, ".") - InStr(1, XX, ",") + 5)
    Range("B1") = x1 & ", " & x2
End Sub

 

[Haluk]

Eğer "Regular Expressions" ile çözüm arıyorsanız, bir modül ilave edip aşağıdaki kod yapıştırın.

Function trimDigits(Addr As Range)
    Dim regExp As Object
   
    If regExp Is Nothing Then
        Set regExp = CreateObject("VBScript.RegExp")
        regExp.Pattern = "(\b\d[\d,.]{8})"
        regExp.Global = True
    End If
   
    If regExp.test(Addr) Then
        Set objMatches = regExp.Execute(Addr)
        trimDigits = objMatches.Item(0).Submatches(0) & ", " & objMatches.Item(1).Submatches(0)
    End If
End Function

Sayfadaki kullanım şekli;

=trimDigits(A1)

.

 

[steppe]

Sub RakamlarıKısalt()
    XX = Range("A1")
    x1 = Left(XX, InStr(1, XX, ".") + 6)
    x2 = Mid(XX, InStr(1, XX, ",") + 2, InStr(InStr(1, XX, ","), XX, ".") - InStr(1, XX, ",") + 5)
    Range("B1") = x1 & ", " & x2
End Sub

NextLevel Hocam,
Yardımlarınız için çok teşekkür ederim. Yalnız A1 hücresinde kısaltma yapmış, A sütunundaki verileri nasıl kısaltabiliriz?

 

[Saban Sertkaya]

Alternatif olsun.

Sub Düğme1_Tıklat()
For a = 1 To [A1048576].End(xlUp).Row
For b = 1 To Len(Cells(a, 1))
If Mid(Cells(a, 1), b, 1) = "." Then Cells(a, 1) = Mid(Cells(a, 1), 1, b + 6)
Next
Next
End Sub

 

[ÖmerFaruk]

"Yalnız A1 hücresinde kısaltma yapmış, A sütunundaki verileri nasıl kısaltabiliriz? "

Yanlış anlamayın.
O kısmı bilerek yapmadım. 300.mesaja gelmişsiniz. Bu sorduğunuzu sizin rahatlıkla yapabiliyor ve koda ekleyebiliyor olmanız lazım.
Biraz gayret.

Sub RakamlarıKısalt()
    For i = 1 To Range("A1").End(xlDown).Row
        XX = Range("A" & i)
        x1 = Left(XX, InStr(1, XX, ".") + 6)
        x2 = Mid(XX, InStr(1, XX, ",") + 2, InStr(InStr(1, XX, ","), XX, ".") - InStr(1, XX, ",") + 5)
        Range("B" & i) = x1 & ", " & x2
    Next i
End Sub

 

[steppe]

Emeği geçen herkese çok teşekkür ederim.