DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhabatüm sayafadaki hücrelerdeki tüm virgüllü değerleri 2 hane sonrasını yukarı yuvarlayan program makro ile yazılabilir mi?
Sub yukarı_yuvarla()
For Each a In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 1)
a.Value = WorksheetFunction.RoundUp(a.Value, 0)
Next
End Sub
Sub yukarı_yuvarla()
For Each a In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 1)
a.Value = WorksheetFunction.RoundUp(a.Value, [COLOR="Red"]2[/COLOR])
Next
End Sub
Şöyle deneyebilirsiniz:bazı değerler metinlerin içerisindede olabiliyor bu değerleride yuvarlaması mümkün mü
Sub yukarı_yuvarla()
For Each a In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 3)
If IsNumeric(a.Value) = True Then _
a.Value = WorksheetFunction.RoundUp(a.Value, 2)
If RetNum(a.Value) <> "" Then _
a.Value = Replace(a.Value, RetNum(a.Value), WorksheetFunction.RoundUp(RetNum(a.Value), 2))
Next
End Sub
Function RetNum(AnyStr As String)
Dim RegEx
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Global = True
.Pattern = "[^\d,]+"
End With
RetNum = RegEx.Replace(AnyStr, "")
Set RegEx = Nothing
End Function