makro ile yuvarlama

[walabi]

Merhaba,

Şöylesi bir sorum olacak. Ekteki örnek dosyada olduğu gibi.

01, 02, ..... 11, 12 şeklinde sayfaları olan bir excel dosyam mevcut.

Bu dosyanın yukarda adları geçen (01, 02, şeklinde ) sayfalarının J ve K sütun değerlerini yuvarlamak istiyorum. 10,12 - 10,55 gibi. Kuruş hanesi 2 hane olacak. Bunu makro ile nasıl yapabilirim.

 

[aliveli06]

Aşağıdaki kodları deneyin.

Sub yuvarla()
For Each sh In ThisWorkbook.Sheets
For i = 2 To sh.Range("j65536").End(3).Row
sh.Cells(i, "k").Value = WorksheetFunction.Round(Cells(i, "k"), 2)
sh.Cells(i, "j").Value = WorksheetFunction.Round(Cells(i, "j"), 2)
Next i
Next
End Sub

 

[walabi]

Sayın aliveli06,

Yazdığınız kodlar istediğim gibi çalışıyor. Yanlız şunu sormam gerekti. Kodlar tüm excel kitabı sayfalarını kapsayacak şekilde çalışmakta gördüğüm. İsimlerini belirtetek istediğim sayfalar üzerinde bu kodun etkili olmamasını nasıl sağlayabilirim.

Örneğin 01 02 03 ... 12 şeklinde oniki adet sayfamvar. Bunlara ek olarak Anasayfa adı altında bir sayfam daha oldunu varsayarsak bu Anasayfa adlı sayfa üzerinde kodların etkili olmamasını nasıl sağlayabiliriz.

 

[Korhan Ayhan]

Aşağıdaki kodu kullanabilirsiniz.

Sub Yuvarla()
    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name <> "Anasayfa" Then
            For X = 2 To Sayfa.Cells(Sayfa.Rows.Count, "J").End(3).Row
                Sayfa.Cells(X, "K").Value = WorksheetFunction.Round(Cells(X, "K"), 2)
                Sayfa.Cells(X, "J").Value = WorksheetFunction.Round(Cells(X, "J"), 2)
            Next
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[walabi]

Teşekkürler Korhan bey.

 

[walabi]

Merhaba,

Aşağıda belirttiğim kod şirket bilgisayarımda sorunsuz çalışırken, ev bilgisayarımda hata vermekte. Sebeb nedir acaba.

Sub Adım_4()

SayfalariTemizle

'On Error Resume Next
    Set S1 = Sheets("Formüller")
    With S1
        For x = 2 To .[i65536].End(3).Row
            If .Cells(x, 8) = "" Or .Cells(x, 8) = "Tediye Fişi" Or .Cells(x, 8) = "Mahsup" Or .Cells(x, 8) = "Paylaştırma" Then GoTo 10
                       
            a = Format(Mid(.Cells(x, 1), 4, 2), "00")
           
            s = Sheets(a).[c65536].End(3).Row + 1
            Sheets(a).Cells(s, 3) = .Cells(x, 20) ' Alış Faturasının Tarihi
            Sheets(a).Cells(s, 5) = .Cells(x, 18)  ' Alış Faturasının Sıra Nosu
            Sheets(a).Cells(s, 6) = .Cells(x, 19)  ' Satıcının Adı/Soy Adı Ünvanı
            Sheets(a).Cells(s, 11) = .Cells(x, 10) ' KDV 'si
            Sheets(a).Cells(s, 1) = .Cells(x, 7)   ' **** matrah hesaplamalası için ***
            Sheets(a).Cells(s, 13) = .Cells(x, 1)
            
10
        Next
    End With
    

Numaraver

    

End Sub

s = Sheets(a).[c65536].End(3).Row + 1 bu satır hata veriyor, sayın hamitcan yazmıştı.


İkinci olarak

Sub Yuvarla()
    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name <> "Anasayfa" Then
            For X = 2 To Sayfa.Cells(Sayfa.Rows.Count, "J").End(3).Row
                Sayfa.Cells(X, "K").Value = WorksheetFunction.Round(Cells(X, "K"), 2)
                Sayfa.Cells(X, "J").Value = WorksheetFunction.Round(Cells(X, "J"), 2)
            Next
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sayın Korhan beyin yazdığı kodlar, Ekteki excel dosyasında

Sub Ay_Degerlerini_Yuvarla()


    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name <> "AnaSayfa" And Sayfa.Name <> "Formüller" And Sayfa.Name <> "Muavin" And Sayfa.Name <> "Vergi_TC_NO" And Sayfa.Name <> "Bul_Değiştir" Then
            For x = 2 To Sayfa.Cells(Sayfa.Rows.Count, "J").End(3).Row
                Sayfa.Cells(x, "K").Value = WorksheetFunction.Round(Cells(x, "K"), 2)
                Sayfa.Cells(x, "J").Value = WorksheetFunction.Round(Cells(x, "J"), 2)
            Next
        End If
    Next
    

End Sub

Şeklinde kendime göre uyarladım. Ekteki dosyada olduğu gibi anamodül adı altında bir kaç modül işlemini sıralayarak birleştirdim.

Bu kod anamodül içinde en son işlem yapmakta. Tüm modüllerin, kodların işlemleri bittikten sonra bu kodu F5 yaparak çalıştırdığımda ilgili sütun değerleri 10,00 şeklinde ondalık değer olmakta. Ancak aynı kodu anamodül altında Call şeklinde çalıştırdığımda ilgili sütun değerlerinin hepsi 0,00 şeklini almakta.

Bu iki sorunu anlayamadım. Cevaplanabilir mi.

 

[Korhan Ayhan]

Yuvarlama kodunu aşağıdaki gibi değiştirip deneyin.

Sub Ay_Degerlerini_Yuvarla()
    For Each Sayfa In ThisWorkbook.Sheets
        If Sayfa.Name <> "AnaSayfa" And Sayfa.Name <> "Formüller" And Sayfa.Name <> "Muavin" And Sayfa.Name <> "Vergi_TC_NO" And Sayfa.Name <> "Bul_Değiştir" Then
            For x = 2 To Sayfa.Cells(Sayfa.Rows.Count, "J").End(3).Row
                Sayfa.Cells(x, "K").Value = WorksheetFunction.Round(Sayfa.Cells(x, "K"), 2)
                Sayfa.Cells(x, "J").Value = WorksheetFunction.Round(Sayfa.Cells(x, "J"), 2)
            Next
        End If
    Next
End Sub

 

[walabi]

Korhan Bey,

 Sayfa.Cells(x, "J").Value = WorksheetFunction.Round(Sayfa.Cells(x, "J"), 2)

Bu satırda hata almaktayım.

type mismatch açıklaması ile.

 

[Korhan Ayhan]

Ben eklediğiniz dosyada denedim. Hata ile karşılaşmadım.

 

[walabi]

Korhan Bey ,

Yani ben de bir anlam veremiyorum. Sayın Hamitcan ın yazmış olduğu kod da dediğim gibi şirket bilgisayarında çalışırken ev bilgisayarımda çalışmıyor. Sığ olan makro bilgime göre enteresan bir durum. Benim eklediğim dosyam üzerinde sizde çalışıyor ise ben de neden hata vermekte, enteresan bir durum.

Rica etsem sizde çalışan dosyayı ekleyebilir misiniz. Bir de sayın hamitcanın yazdığı kod ile ilgili yorum yapma imkanınız var mıdır. Burda da yeni farkettiğim bir durum mevcut. Önemli midir bilmem ama A sütunu için tarih formatı şirket bilgisayarım da 01.01.2014 gibi ayarlı. Görünen tarih değeri ve hücreyi seçtiğimde görünen format aynı.

Ancak şuan ev bilgisayarımda A sütunu için tarih değerleri 01.01.2014 şeklinde görünürken, tek tek hücre seçerek kontrol ettiğimde değerler 1.1.2014 şeklinde olmakta.

Formatı dd/mm/yyyy şeklinde ayarlamama rağmen.

 

[Korhan Ayhan]

Sanırım evde 2007 versiyon kullanıyorsunuz.

 

[walabi]

Program listeme baktığımda Microsoft Office Professional Plus 2010 görünmekte.

 

[Korhan Ayhan]

Hata vermesini gerektirecek bir durum görünmüyor.

 

[walabi]

Korhan bey, tarih ile ilgili problem anladığım kadarı ile 1.1.2014 şeklinde format olmasından. İlgili değerleri 01.01.2014 şekline dönderdiğimde hata vermiyor.

Yani ham veri şirket bilgisayarında 01.01.2014 olarak görünmekte, evde 1.1.2014 , ama sebebini anlamış değilim.

Yuvarlama ile ilgili son yapmış olduğunuz değişikliği de şirket bilgisayarımda deneyeceğim.

Teşekkürler alakanız için.

 

[Korhan Ayhan]

Evdeki bilgisayarınızın bölgesel ayarlarını kontrol ediniz. Bahsettiğiniz tarih formatı bölgesel ayarlardan etkilenmektedir.

 

[walabi]

Teşekkürler, Tarih ile hata bundan kaynaklanıyormuş,

Kısa Tarih adlı ayar g.a.yyyy şeklindeydi. gg.aa.yyyy şekline çevirince tarih formatından dolayı hata almadım.

 

[walabi]

Korhan Bey sayı formatı ile ilgili problemide bugün çözdüm. Teşekkürler,

Son bir isteğim olacak.

Daha önce örnek dosya eklemiştim. Bu dosya içinde "Formüller" adlı sayfanın H sütununu ( Kategori ) baz alarak Mahsup, Tediye Fişi, Paylaştırma ve Boş("") olan hücrelerin satırlarını sıra ile Diger_Kayitlar adı altında bir sayfaya yazdırmak istiyorum.

Aşağıdaki kodu nasıl düzeltmem gerekir ya da bunları yapabilecek bir kod.

Sub Diger_Kayitlar()

Satirlari_Temizle

Dim x As Long
Dim y As Long
Dim satir As Long

For x = 2 To Cells(Rows.Count, "T").End(3).Row
For y = 1 To 20

If Sheets("Formüller").Cells(x, 8).Value = "" Then
    Sheets("Diger_Kayitlar").Cells(x, y).Value = Sheets("Formüller").Cells(x, y).Value
     
End If


Next
Next


End Sub

 

[walabi]

Korhan Bey sayı formatı ile ilgili problemide bugün çözdüm. Teşekkürler,

Son bir isteğim olacak.

Daha önce örnek dosya eklemiştim. Bu dosya içinde "Formüller" adlı sayfanın H sütununu ( Kategori ) baz alarak Mahsup, Tediye Fişi, Paylaştırma ve Boş("") olan hücrelerin satırlarını sıra ile Diger_Kayitlar adı altında bir sayfaya yazdırmak istiyorum.

Aşağıdaki kodu nasıl düzeltmem gerekir ya da bunları yapabilecek bir kod.

Sub Diger_Kayitlar()

Satirlari_Temizle

Dim x As Long
Dim y As Long
Dim satir As Long

For x = 2 To Cells(Rows.Count, "T").End(3).Row
For y = 1 To 20

If Sheets("Formüller").Cells(x, 8).Value = "" Then
    Sheets("Diger_Kayitlar").Cells(x, y).Value = Sheets("Formüller").Cells(x, y).Value
     
End If


Next
Next


End Sub

Merhaba, bu mesajıma bir üstat cevap verebilir mi.

Yapmak istediğim şu.
Formüller ve Diger_Kayitlar adı altında iki sayfam var.
Formüller sayfasındaki H sütunun değerlerine bakarak, değeri Mahsup, Paylaştırma, Tediye Fişi ve boş olan hücrelerin satırlarını Diger_Kayitlar adlı sayfaya 2. satırdan itibaren sıra ile yazdırmak. Sütun sayısı 20 toplamda. Yani A-T sütunları arası.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long
    Dim Satir As Long
    Dim Veri As String
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Diger_Kayitlar")
    Set S2 = Sheets("Formüller")

    S1.Range("A2:T" & S1.Rows.Count).ClearContents
    Satir = 2
    
    For X = 2 To S2.Cells(S2.Rows.Count, 1).End(3).Row
        Veri = UCase(Replace(Replace(S2.Cells(X, "H"), "i", "İ"), "ı", "I"))
        If Veri = "MAHSUP" Or _
        Veri = "TEDİYE FİŞİ" Or _
        Veri = "PAYLAŞTIRMA" Or _
        Veri = "" Then
            S2.Rows(X).Copy S1.Cells(Satir, 1)
            Satir = Satir + 1
        End If
    Next

    Set S1 = Nothing
    Set S2 = Nothing

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub