• DİKKAT

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

Hakediş Dosyası için Makro ihtiyacım var.

Katılım
17 Kasım 2011
Mesajlar
5
Excel Vers. ve Dili
2010 türkçe
Herkese selamlar,

Arkadaşlar Ben elektrik teknikeriyim ve kullanıdığım bir hakediş dosyasında büyük bir sıkıntım var.Ekteki dosyanın metraj bölümü şuanda 6000 satıra ulaştı ve buda bilgisayarı kasar duruma geldi. Sebebide bakanlar anlayacaktır. Formul yüzünden,
her sayfada formul var. formullerde; düşeyara ve çoketopla aslında bilgisayarı kastırmasa hiç sıkıntım olmaz ama her değer girdiğimde otomatik hesap yapıyor ve buda beni çok geriyor. Otomatik hesabı kapatıncada bazı kalemleri yanlış giriyorum. Bu sebeplede otomatikte tutmak zorundayım. Ancak Makro ile düzenlenirse çok daha hızlı olacaktır. Ben makro yazmasını bilmiyorum ama kesin öğreneceğim orası kesin.

Ancak bugün bana yardımcı olursanız sevinirim. Şimdiden ilgili Arkadaşlara Teşekkürler...

Bu arada Excel 2010 kullanıyorum.
 

Ekli dosyalar

Bir de tam olarak ne istediğinizi, nerede ne gibi değişiklik yapılacağını da yazsaydınız. Neyse, anladığım kadarıyla şöyle bir şeyler yaptım:

Aşağıdaki kodları metraj sayfasının kod bölümüne yapıştırın. Böylece metraj sayfasında b sütununua elle veri girdikçe C sütununa malzeme adını, D sütununa da birimi gelecektir. böylece o sütunlardaki düşeyara formüllerini silebilirsiniz. Tabi düzgün çalışması için B sütunundaki her hücreye girip enter yapmanız ya da bunu da ayrıca makroyla haletmeniz gerekir:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
Set çarşaf = Worksheets("çarşaf").Range("a:d")
Cells(Target.Row, Target.Column + 1) = Application.VLookup(Target, çarşaf, 2, False)
Cells(Target.Row, Target.Column + 3) = Application.VLookup(Target, çarşaf, 4, False)
End Sub
 
Son düzenleme:
Mevcut verilerinizi değiştirmek için bir defaya mahsus aşağıdaki makroyu kullanabilirsiniz:
Kod:
Sub değiştir()
Set çarşaf = Worksheets("çarşaf").Range("a:d")
For i = 2 To Range("b1").End(xlDown).Row
    Range("c" & i) = Application.VLookup(Cells(i, 2), çarşaf, 2, False)
    Range("e" & i) = Application.VLookup(Cells(i, 2), çarşaf, 4, False)
    Next i
End Sub
 
Sağol YUSUF44

Eyvallah beni gayet iyi anlamışsın ve çok daha güzel ve hızlı oldu. Biraz çok oluyorum farkındayım ancak ben bütün sayfalardaki formüller için genel konuşmuştum. Yani her sayfada formüller var. Bu formüller yerine makro kullanmak istiyorum.

TEŞEKKÜRLER...
 
Yeşil defter sayfasının kod bölümünde aşağıdaki kodları kullanabilirsiniz:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a:a")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Set çarşaf = Worksheets("çarşaf").Range("a:d")
Set miktar = Worksheets("metraj").Range("d:d")
Set hakediş = Worksheets("metraj").Range("a:a")
Set kod = Worksheets("metraj").Range("b:b")
Cells(Target.Row, Target.Column + 1) = Application.VLookup(Target, çarşaf, 2, False)
Cells(Target.Row, Target.Column + 2) = Application.VLookup(Target, çarşaf, 4, False)
Cells(Target.Row, Target.Column + 3) = Application.SumIfs(miktar, hakediş, "H1", kod, Target)
Cells(Target.Row, Target.Column + 4) = Application.SumIfs(miktar, hakediş, "H2", kod, Target)
Cells(Target.Row, Target.Column + 6) = Cells(Target.Row, Target.Column + 3) + Cells(Target.Row, Target.Column + 4)
End Sub
 
Geri
Üst