• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tüm Çalışma Sayfalarındaki hücrelerin değerlerine sabit bir sayı eklemek

M

MAJORTOUR

Katılım
3 Mayıs 2012
Mesajlar
16
Excel Vers. ve Dili
2010
Selamlar. Bir excell dosyasında yaklaşık 150 tane alt çalışma sayfaları oluşturulmuş.Ben bu sayfaların içerisinde yer alan bazı hücrelerde ki sayıların üzerine +3 sabit eklemek istiyorum.Bu hücreler her çalışma sayfasında ayni Matrise eşdeğer(satır;sütun). Böylece Makro kodları ile tüm çalışma sayfalarını F5 liyerek tamamını değiştirmek ve yeni rakamlara(örneğin satış fiyatları diyelim) Ulaşmak istiyorum. Ayrıca her sayfa için indexe (Main page) dönüş ataması nasıl kodların yardımınıza ihtiyacım var mersi.
 

Ekli dosyalar

Arkadaşlar ilk hücre E 30 dan başlıyor € işaretli olan hücrelere + 3 gibi bir sabiti eklemek ve bunuda kitaptaki tüm çalışma sayfasına insertlemek istiyorum. TEKRAR TEŞEKKÜR EDERİM YARDIM EDECEK ARKADAŞLARIMA...
 
V36 hücresine 3 rakamını yazın ve aşağıdaki kodu çalıştırın. Kod, sadece ("E30:R41") aralğında işlem yapmaktadır
Kod: 
Sub SayiyiTabloyaKopyala()
Application.ScreenUpdating = False
For Each sht In Worksheets
sht.Select
    Range("V36").Select
    Selection.Copy
    Range("E30:R41").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlAdd, _
        SkipBlanks:=False, Transpose:=False
Next
Application.ScreenUpdating = True
End Sub
 
Hamitcan beye teşekkürler

teşekkür ederim Hamitcan size. Bu çalışma kitabında sayfalar yan yana olduğu için ve her çalışma sayfasındaki aralık sabit olduğu için kod +3 leri ekledi. Ancak bazı projelerde alt alta olduğu zaman nasıl bir farklı kod yazılır incelermisiniz lütfen. Ek olarak size dosyanın boyutu 3.5 MB olduğu için upload olamadı. mail adresiniz varsa ona yollamaya çalışayım kendi mailimden.Tekrar teşekkürler
 
Son düzenleme:
Bence tablolarınızı standartlaştırmayı deneyin.
 
Teşekkürler

tablolar sejoure diye bir Acenta programından excell olarak çıkıyor. Son yıllarda Operatörler (TUR) özellikle Ruslar yaklaşık 500 tane oteli alt alta istiyorlar böyle olunca mail yolu ile giden dosya küçülüyor ve daha rahat gidebiliyor. Tabi yan yana olunca çalışma sayfaları çok daha basit ama alt alta olunca yüzlerce tablo üzerinde oynama yapmak çok uzun zaman alacağından VBA macro kodları ile yapmaya çalışıyorum. Daha önce İsim Telefon adres gibi değişiklikleri içeren kodlar yazarak hallettim. mail adresim ''majortourturkey@yahoo.com'' bana mail atarsanız sizden destek alabilirim ve Tatile beklerim
 
Yeni bir dosya içinde yapmak istediklerinizi -çok karışık olmadan- açıklarsanız birşeyler yapmaya çalışırım. Çok kapsamlı çalışmalar için zamanım yok, kusura bakmayın.
 
Macro Kodlarının çalışma sayfalarının tümüne uygulanması

Hamitcan bey selam. Yukarıda yazdığınız macro kodu, yalnızca 1 sayfa için uygulanıyor ben size tabiiki 150 sayfa gönderemem, ancak size örnek olsun diye 3 sayfa attac.. layayım. zamanınız varsa bakınız zira o kodlar çalıştıramadı +3 leri.
Selam kolaylıklar.

Serdar
 

Ekli dosyalar

Merhaba,

Eklediğiniz dosyada hangi hücrelere +3 eklenecek?

Ayrıca +3 eklerken herhangi bir koşul varmı?
 
Merhabalar, Aslında yaklaşın 100 tane çalışma sayfasından oluşan bu çalışma kitabının her birisi içinde bulunan hücrelerde hazırlanmış olan euro simgeli fiyatlar var amacımız bu fiyatların üzerine satış fiyatları oluşturmak için +3 değerini koyup örneğin herhangi bir hücrede yazan 55 € +3 € gelerek = 58 € olacak şekilde değişecek. ben burada 3 tane otelin çalışma sayfasını yeni bir kitap oluşturarak kopyaladım. Eğer herhangi bir kod yazılırsa tabi ben o kodları VBA modunda asıl çalışma kitabındaki 100 taneden fazla olan tüm sayfalara F5 liyeceğim daha önce ben isim adres vergi no larlada çok uğraşıp onlara kod bulmuştum ama daha önce bilgi veren hamit can beyin kodları yalnızca bir tek çalışma sayfası için geçerli olduğundan işime yaramadı ancak yinede emeğine bir kez daha teşekkür ederim.

sizede teşekkür ederim.

Selamlar...
 
Merhaba,

Aşağıdaki kodu deneyiniz.

Kod içindeki "Hariç_Sayfalar" dizisine bu işlemi yapmak istemediğiniz sayfa isimlerini yazarsınız.
Ayrıca Euro değerlerin kontrol edileceği hücreler "A1:AA250" aralığı olarak tanımlanmıştır. Bunuda dilediğiniz gibi değiştirebilirsiniz.


Kod: 
Sub EURO_OLAN_HÜCRELERE_ARTI_ÜÇ_EKLE()
    Dim Sayfa As Worksheet, Hariç_Sayfalar(), Hücre As Range
    Dim X As Integer, Son_Satır As Long, Son_Sütun As Integer, Adres As String
 
    Application.ScreenUpdating = False
 
    Hariç_Sayfalar = Array("KEMER", "TEKİROVA")
 
    For Each Sayfa In ThisWorkbook.Worksheets
        For X = 0 To UBound(Hariç_Sayfalar)
            If Sayfa.Name = Hariç_Sayfalar(X) Then
                GoTo 10
            End If
        Next
 
        If WorksheetFunction.CountA(Sayfa.Cells) > 0 Then
            Son_Satır = Sayfa.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Son_Sütun = Sayfa.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Adres = "A1:" & Cells(Son_Satır, Son_Sütun).Address(0, 0)
    
            For Each Hücre In Sayfa.Range(Adres)
                If InStr(1, Hücre.NumberFormat, "€") > 0 And Hücre.HasFormula = False Then
                    If IsNumeric(Hücre.Value) Then Hücre.Value = Hücre.Value + 3
                End If
            Next
        End If
10  Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Ben de bir örnek yaptım. Tablolarınız standart olmadığı için aralığı, en iyisi siz, belirleyin. AH1 hücresine yazacağınız bir rakamı seçtiğiniz aralığa kopyalayacaktır.
Kod: 
Sub SayiyiTabloyaKopyala()
 Set Alan = Application.InputBox(Prompt:= _
                "Hücrenin Kopyalanacağı Alanı Seçin.", _
                    Title:="ALAN SEÇME", Type:=8)
 Range("AH1").Select
 Selection.Copy

If Not Alan Is Nothing Then
Alan.Select
     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlAdd, _
        SkipBlanks:=False, Transpose:=False
End If
End Sub
 
Bravo Korhan Ayhan, çok yerinde bir kodla çalışma sayfalarına uygulama oldu daha önce Hamit Can beye hazırladığım dosyada başarı ile uygulandı. Şimdi tüm kitap için uygulayacağım. Üstelik orada çocuk yaşları var yani kişi başı 3€ uygulamış. eğer hücre başı 3€ uygulasaydı olmazdı. yani double (çift kişi) konaklamalarında +6€ hücreye eklemiş. Tabi bu excell tabanlı bir yazılım Acenta programı.Sanırım formulle hazırlamış demekki tüm konfigirasyonları hesaplıyor.Bu benim korktuğum asıl sorundu. O sanırım hallolmuş. Teşekkür ederim Hem size ve Hamit Can beye de.

Teşekkürler.

Serdar
 
Sayın Ayhan, Kodları çoklu çalışma sayfalarına uyguladığımızda çok uzun süre almakta. Tablolar arası karşılaştırma yapacağız. Bu denli uzun sürmesi tek tek hücrelere gidip +3 eklemesindendir sanıyorum Alan Aralığınıda (E30:U98) GİBİ DARALTTIM. Selam.
 
Korhan bey okurmusunuz ltf.

Selam Korah Ayhan bey, Yukarıda yazdığınız kodu benzer daha az kapsamlı bir tabloya da uygulatmak istedim. Ancak Tabloda fiyatlarda € olmadığı için € ekledim ve ondalık olarak sadeleştirdim örnek 70.00 ise 70 € olarak düzelttim. Tabi Hücre biçimlendirmeden, yapıldı. VBA odunda Kod yazılımına gelindiğinde gerekli satır ve sütunları (B14:J44) OLARAK UPGRADE ETTİM. "Hariç Sayfalarıda" "INDEX" olarak belirttim yazdım koda . Ama sonuç olması gerektiği gibi değildi daha öncede yazdığımız kod oradaki gibi sonuç vermedi.ekledim o Çalışma Kitabını daraltarak ekledim. Daha önceki kod ile yazıldığında type mismatch uyarısını veriyor end tıklanınca excell tablosunun her € gördüğü hücresine +3 ilave etmiyor Tanımlanan alan içerisindeki bazı tablolara ilave ediyor yada bozuyor...

Hücre.Value = Hücre.Value + 3 bu kodu sarı blokla high-light olarak gösteriyor.

teşekkür ederim Korhan bey.

Serdar
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Üstteki mesajımdaki koda küçük bir ekleme yaptım. Tekrar deneyiniz.

Kod bende son dosyanıza göre işlemi 1-2 saniyede bitiriyor. Sayfaları biraz daha çoğalttım. 5-6 saniye kadar sürüyor.
 
Anladım Korhan bey Nümeric (sayısal) değer vurgusu hücreye zaten o bölüm uyarı verdi ancak, neden önceki çalışma kitabında deşiklik yaptı da burada olmadı anlayamadım.Yoksa ilk kod gayet iyi çalıştı. Ama şimdi içime korku düştü ilk kitabın çalışma sayfalarını tek tek kontrol edeyim.Teşekkür ederim. Korhan bey uyguladım reelize oldu.Bana Kitap öneriniz Makro kodları açıklamalı ve bol örnekli... İyi sezonlar dilerim. İyi Bir Barın duble satışda beverage costu nedir??Haydi Buyurun
 
Selam ,
Bu bölümde excell çalışma sayfalarının (çoklu sayfalar), belirli bölümlerine para birimleri yazılmışsa o hücrelerin içerisine + sabit sayı ekleyerek yeni değere ulaşmayı kodladık. bu para birimi € idi .Tabi farklı birimler içinde değişmeyecekti. Sorum şu eğer bu tür çalışmalarda hücrelerin içerisinde para birimi değilde direk sayılar olsaydı ,o rakamlara + 3 (örneğin) eklenmek istense tabi Her çalışma sayfasının Matrisleri eş olmayacaktır normal olarak. (satır:sütun). Nasıl bir kodlama ile artı değer kazandıracağız.
 
Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Matrisleri sayfalardaki dolu olan hücrelere göre düzenledim. Üstteki önerdiğim kodu da bu şekilde düzenledim. Tekrar deneyin bakalım kodun çalışma hızı azalacak mı?

Kod: 
Sub SAYI_OLAN_HÜCRELERE_ARTI_ÜÇ_EKLE()
    Dim Sayfa As Worksheet, Hariç_Sayfalar(), Hücre As Range
    Dim X As Integer, Son_Satır As Long, Son_Sütun As Integer, Adres As String
 
    Application.ScreenUpdating = False
 
    Hariç_Sayfalar = Array("KEMER", "TEKİROVA")
 
    For Each Sayfa In ThisWorkbook.Worksheets
        For X = 0 To UBound(Hariç_Sayfalar)
            If Sayfa.Name = Hariç_Sayfalar(X) Then
                GoTo 10
            End If
        Next
 
        If WorksheetFunction.CountA(Sayfa.Cells) > 0 Then
            Son_Satır = Sayfa.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Son_Sütun = Sayfa.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Adres = "A1:" & Cells(Son_Satır, Son_Sütun).Address(0, 0)
 
            For Each Hücre In Sayfa.Range(Adres)
                If Hücre.HasFormula = False Then
                    If IsNumeric(Hücre.Value) Then Hücre.Value = Hücre.Value + 3
                End If
            Next
        End If
10  Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst