Yuvarlama ve gereksizleri silme

[gecemavisi]

Saygıdeğer arkadaşlar;
Benim formülüm sonucunda değerler aşağıdaki gibi çıkıyor.

mesela :
12,467568
11,54678
bu sayılarda d7 ile d 100 satırları arasındaki tüm sayıların 3. rakamını yuvarlatıp virgülden sonra sadece iki rakamın kalmasını makro ile nasıl sağlarım.Ayrıca Makro hemen kendini göstermeli.
ya da ben elimle değiştirmek istediğim tüm sayıları seçip bir butonla değiştirmeliyim. Yukardaki sayılar mesela "12,47", "11,55" şeklinde olmalı.
Umarım derdimi anlatabilmişimdir.
Yardımınız için şimdiden teşekkür ediyorum.

 

[abdi]

d7:d100 aralığındaki sayıların yuvarlanması için,
isterseniz aşağıdaki kodu bir düğmeye de atayabilirsiniz.
1 adet modul ekleyip modulun içine yazın

Sub Yuvarla()
Dim i, son As Integer
son = [d65536].End(3).Row
For i = 7 To son
Cells(i, 4).Value = Round(Cells(i, 4).Value, 2)
Next i
End Sub

bir diğer alternatif kod
sayfanın ilgili sutununda değişiklik olunca çalışan kod
ilgili sayfanın kod sayfasına yazın ilgili sütun 4 yani d sütunudur
kendinize uyarlayınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 4 Then

If ActiveCell.Offset(-1, 0).Value <> "" Then
ActiveCell.Offset(-1, 0).Value = Round(ActiveCell.Offset(-1, 0).Value, 2)
Else
Exit Sub
End If
End If
End Sub

bir diğer alternatif kod ise
sutun ve satırları değişkene bağlanmış sizin seçebileceğiniz esnek bir kod
ilgili module

Sub yuvarla2()
Dim m, i, son As Integer
Dim deger As String

i = InputBox("lütfen satır rakamını giriniz")

deger = InputBox("lütfen sutun adını giriniz")

If i <> "" Then

son = Cells(Cells.Rows.Count, deger).End(xlUp).Row 'Application.CountA(Columns(deger))
Debug.Print son
'[deger&65536].End(3).Row
For m = i To son
Cells(m, deger).Value = Round(Cells(m, deger).Value, 2)
Next

Else
Exit Sub
End If
End Sub

 

[gecemavisi]

Sn Abdi;
Sub yuvarla2()
Dim m, i, son As Integer
Dim deger As String

i = InputBox("lütfen satır rakamını giriniz")

deger = InputBox("lütfen sutun adını giriniz")

If i <> "" Then

son = Cells(Cells.Rows.Count, deger).End(xlUp).Row 'Application.CountA(Columns(deger))
Debug.Print son
'[deger&65536].End(3).Row
For m = i To son
Cells(m, deger).Value = Round(Cells(m, deger).Value, 2)
Next

Else
Exit Sub
End If
End Sub


Kodlarını kendimize özelleştirdiğimizde bunlarda satır aralığını nasıl belirtiriz.
Sadece tek bir satırdaki tek hücre değilde mesela c sütunundaki 1 ile 4 arasındaki satırları açılan kutuya nasıl girebiliriz. Ya da kodları nasıl değiştirmek gerekir.

Saygılarımla...

 

[abdi]

Sn Abdi;
Sub yuvarla2()
Dim m, i, son As Integer
Dim deger As String

i = InputBox("lütfen satır rakamını giriniz")

deger = InputBox("lütfen sutun adını giriniz")

If i <> "" Then

son = Cells(Cells.Rows.Count, deger).End(xlUp).Row 'Application.CountA(Columns(deger))
Debug.Print son
'[deger&65536].End(3).Row
For m = i To son
Cells(m, deger).Value = Round(Cells(m, deger).Value, 2)
Next

Else
Exit Sub
End If
End Sub


Kodlarını kendimize özelleştirdiğimizde bunlarda satır aralığını nasıl belirtiriz.
Sadece tek bir satırdaki tek hücre değilde mesela c sütunundaki 1 ile 4 arasındaki satırları açılan kutuya nasıl girebiliriz. Ya da kodları nasıl değiştirmek gerekir.

Saygılarımla...

Sanırım ikinci inputboxla bu sorun çözülür
Yukarıdaki kodda son satırını silip yenisiyle değiştirmeniz gerekecek
[vb:1:6fb66f69b5]Son = InputBox("lütfen son satır rakamını giriniz")
[/vb:1:6fb66f69b5]
şeklinde değiştirirseniz istediğiniz olur.

 

[gecemavisi]

Sn Abdi Bey;
Yardımınız için siz değerli excel sever arkadaşıma minnettarım.
Ne güzel kardeşlik, ne güzel yardımcı olmak, ne güzel dayanışmak

 

[yenilik]

abdi,
abdi bey bizdede aynı sorun var
örnek a1&b1 dediğimizde eğer bu hücrelerden bir tanesinde formül var ise çıkan sonuçta virgülden sonraki değerleri birleştirdiğimiz hücrede hepsini gösteriyor.
bunu değiştirmek için ne yapabiliriz. saygı selam sunarım.
örnek a1 ahmet b1'de 10/3 ise sonucu 3,333333 gibi olduğundan
birleştirmek istediğimiz hücrede d1 de sonuç ahmet3,3333333 oluyor biz bunun yerine ahmet3,33 istiyoruz bunu yapabilirmiyiz teşekkürler.

 

[abdi]

Sayın yenilik,

Basit bir örnek dosya ekleyeblirmisiniz.
örnekli olarak ne yapmak istediğinizi anlatan

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki gibi formülüze edip denermisiniz.

=A1 & METNEÇEVİR(B1;"#.##0,00")