Birden Fazla Hücreyi Yuvarlama

[shiro]

merhaba, alt alta birden fazla hücreyi 2 basamağa yuvarlamak istiyorum ve hepsini aynı hücre içinde yuvarlamak istiyorum, yardımcı olur musunuz

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayın.

Yuvarlama yapacağınız hücreleri seçtikten sonra kodu çalıştırın.

Sub Makro1()

    Dim hcr As Range
    
    For Each hcr In Selection
        hcr = Round(hcr, 2)
    Next hcr
    
End Sub

 

[shiro]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayın.

Yuvarlama yapacağınız hücreleri seçtikten sonra kodu çalıştırın.

Sub Makro1()

    Dim hcr As Range
   
    For Each hcr In Selection
        hcr = Round(hcr, 2)
    Next hcr
   
End Sub

bu şekilde yaptığımda rakamlar yuvarlanıyor fakat hücrelerdeki formüller gidiyor, başta belirtmeyi unuttum, formüller gitmeden o hücrelere toplu bir şekilde yuvarla eklenebilir mi?

 

[Necdet]

bu şekilde yaptığımda rakamlar yuvarlanıyor fakat hücrelerdeki formüller gidiyor, başta belirtmeyi unuttum, formüller gitmeden o hücrelere toplu bir şekilde yuvarla eklenebilir mi?

Hep öyle oluyor zaten, önce sorup sonra farklı bir durum vardı diyorsunuz.

Formülünüzde yuvarlamayı halletmelisiniz, fazladan işlem yapmaya gerek kalmaz.

=YUVARLA(Formülünüz;2)
şeklinde.

 

[Ömer]

Merhaba,

Makro ile düzeltmek için. A1:A4 aralığını kendinize göre değiştiriniz.

Sub yuvarla()

    Dim h As Range, c As Byte, adr As String, t As String
    
    For Each h In Range("A1:A4")
        If h.HasFormula = True Then
            c = InStr(h.Formula, "ROUND")
            If c = 0 Then
                adr = h.Address(, , xlR1C1, External:=True)
                t = Right(h.Formula, Len(h.Formula) - 1)
                If ExecuteExcel4Macro("Get.Cell(49," & adr & ")") = True Then
                    h.FormulaArray = "=Round(" & t & " ,2)"
                Else
                    h.Formula = "=Round(" & t & " ,2)"
                End If
            End If
        End If
    Next h
    
End Sub

 

[shiro]

Hep öyle oluyor zaten, önce sorup sonra farklı bir durum vardı diyorsunuz.

Formülünüzde yuvarlamayı halletmelisiniz, fazladan işlem yapmaya gerek kalmaz.

=YUVARLA(Formülünüz;2)
şeklinde.

evet belki sizin kadar excele hakim olmadığımızdandır? bir de böyle düşünmek gerek!
500 satıra tek tek yuvarla atmamak içindi zaten sorum,
yine de tşk.

 

[shiro]

Merhaba,

Makro ile düzeltmek için. A1:A4 aralığını kendinize göre değiştiriniz.

Sub yuvarla()

    Dim h As Range, c As Byte, adr As String, t As String
   
    For Each h In Range("A1:A4")
        If h.HasFormula = True Then
            c = InStr(h.Formula, "ROUND")
            If c = 0 Then
                adr = h.Address(, , xlR1C1, External:=True)
                t = Right(h.Formula, Len(h.Formula) - 1)
                If ExecuteExcel4Macro("Get.Cell(49," & adr & ")") = True Then
                    h.FormulaArray = "=Round(" & t & " ,2)"
                Else
                    h.Formula = "=Round(" & t & " ,2)"
                End If
            End If
        End If
    Next h
   
End Sub

tam olarak buydu, çok teşekkürler