Fiyat değişince, eski hesaplar değişmesin...

[manly]

FİYAT sayfasındaki herhangi bir ürünün fiyatı değiştiğinde, VERİ sayfasında daha önce girilen ürün fiyat hesaplamaları değişmesin istiyorum.

 

[Korhan Ayhan]

Selamlar,

Geçici olarak ARAÇLAR-SEÇENEKLER-HESAPLAMA-ELLE menüsünü uygulayarak çözüm üretebilirsiniz.

 

[manly]

Teşekkürler...
Evet geçici işimi görür ama,
Başka bir yolu yok mu? Kalıcı bir çözüm...

 

[Korhan Ayhan]

Selamlar,

Formüllerinizi makroya çevirirseniz kalıcı çözüm olur. Dilediğiniz zaman fiyatları güncelleyebilirsiniz.

 

[manly]

Makroya çevirme konusunda yardımcı olur musunuz?...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub HESAPLA()
    Dim X As Long, Y As Byte
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Sheets("VERİ").Select
    ActiveSheet.Unprotect "1"
    
    For X = 3 To Range("A65536").End(3).Row
        If Cells(X, "A") <> "" Then
            For Y = 7 To 77 Step 2
                If Cells(X, Y) = "" Then Cells(X, Y + 1) = 0
                If WorksheetFunction.CountIf(Sheets("FİYAT").Range("A:A"), Cells(1, Y)) = 0 Then
                    Cells(X, Y + 1) = 0
                Else
                    Cells(X, Y + 1) = WorksheetFunction.VLookup(Cells(1, Y), Sheets("FİYAT").Range("A:B"), 2, 0) * Cells(X, Y)
                End If
            Next
        End If
    Next
 
    ActiveSheet.Protect "1"
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[manly]

Korhan hocam hesaplama makrosu çok güzel çalışıyor. Ama yeni bir kayıt yaptım. Mesela çay fiyatı 3 TL. hesaplamayı yaptı. İkinci kayıtta çay fiyatı 5 TL. yapıp hesaplattım. İlk kayıttaki veriyi de 5 TL.den hesaplayıp değiştirdi. Fiyat değiştiğinde önceki kayıtların hesapları sabit kalmalı...

 

[manly]

Fiyat değiştiğinde önceki kayıtların hesapları sabit kalmalı...

 

[Korhan Ayhan]

Selamlar,

VERİ isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G3:BZ65536")) Is Nothing Then Exit Sub
    If Target.Column Mod 2 = 1 Then
       Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
       
       ActiveSheet.Unprotect "1"
       
       If IsNumeric(Target) Then
           If WorksheetFunction.CountIf(Sheets("FİYAT").Range("A:A"), Cells(1, Target.Column)) = 0 Then
               Target.Next = 0
           Else
               Target.Next = WorksheetFunction.VLookup(Cells(1, Target.Column), Sheets("FİYAT").Range("A:B"), 2, 0) * Target
           End If
       End If
       
       ActiveSheet.Protect "1"
    
       Application.Calculation = xlCalculationAutomatic
       Application.ScreenUpdating = True
    End If
End Sub

 

[manly]

Hocam işin içinden çıkamadım..Bu kodu tam olarak nereye eklemem gerekiyor.. Nereyi denediysem değişen bir şey olmadı..

 

[manly]

Selamlar,

VERİ isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G3:BZ65536")) Is Nothing Then Exit Sub
    If Target.Column Mod 2 = 1 Then
       Application.ScreenUpdating = False
       Application.Calculation = xlCalculationManual
       
       ActiveSheet.Unprotect "1"
       
       If IsNumeric(Target) Then
           If WorksheetFunction.CountIf(Sheets("FİYAT").Range("A:A"), Cells(1, Target.Column)) = 0 Then
               Target.Next = 0
           Else
               Target.Next = WorksheetFunction.VLookup(Cells(1, Target.Column), Sheets("FİYAT").Range("A:B"), 2, 0) * Target
           End If
       End If
       
       ActiveSheet.Protect "1"
    
       Application.Calculation = xlCalculationAutomatic
       Application.ScreenUpdating = True
    End If
End Sub

Hocam bu kodu "Thisworkbook" kısmına ekledim ama değişen bir şey yok...

 

[manly]

Korhan Hocam yardım lütfen...

 

[Korhan Ayhan]

Selamlar,

Yapmanız gereken işlem;

VERİ isimli sayfanızı seçin.
Sayfa ismi (sekmesi) üzerinde sağ klik yapın.
Açılan menüden KOD GÖRÜNTÜLE seçeneğini seçin.

Bu aşamadan sonra karşınıza kod editor penceresi gelecektir.
Sağ taraftaki beyaz alana vermiş olduğum kodu uygulayın.

Siz sayfada kahverengi sütunlara değer girdikçe hemen yanındaki sütunlara değerler gelecektir.

 

[manly]

Selamlar,

Korhan Hocam çok teşekkürler...Ellerinize sağlık...

Hocam bir sorum daha olacak...Menü Butonuna basıp, çıkan Userformda YENİ KAYIT butonuna basınca gelen Userformda Müşteri No hanesi "B" sütunundaki en son sayıdan sonrası olsun istiyorum.

 

[Korhan Ayhan]

Selamlar,

"YeniKayit" isimli formunuzun kod bölümüne aşağıdaki kodu uygulayın.

Private Sub UserForm_Initialize()
    TextBox2 = Range("B65536").End(3) + 1
End Sub

 

[manly]

Çok Teşekkürler hocam ellerinize sağlık....


Hocam biraz çok oluyorum ama soru sordukça yeni şeyler öğreniyorum...

Fsütununda ve 2 'nci satırda ki formülleri de kaldırıp Makro yazabilir miyiz?...

 

[baydeniro]

Sayı Korhan Ayhan elinize, aklınıza sağlık. Text lere formul atamayı bilmiyordum. Text1 e günü tarihini kendiliğinden getirmesi için aşağıdaki kodu yazdım ancak olmadı.

Private Sub UserForm_Click()
TextBox1 = TODAY()
End Sub

 

[Korhan Ayhan]

Selamlar,

#13 nolu mesajımdaki dosyayı güncelledim. İncelermisiniz.

Çok Teşekkürler hocam ellerinize sağlık....


Hocam biraz çok oluyorum ama soru sordukça yeni şeyler öğreniyorum...

Fsütununda ve 2 'nci satırda ki formülleri de kaldırıp Makro yazabilir miyiz?...

 

[Korhan Ayhan]

Sayı Korhan Ayhan elinize, aklınıza sağlık. Text lere formul atamayı bilmiyordum. Text1 e günü tarihini kendiliğinden getirmesi için aşağıdaki kodu yazdım ancak olmadı.

Private Sub UserForm_Click()
TextBox1 = TODAY()
End Sub

Selamlar,

Sn. serdarokan,

Siz kodu excel hücresine yazar gibi yazmışsınız. Kod bölümünde işler biraz değişiktir.

Sizim yazım şeklinizi aşağıdaki şekilde çalışır hale getirebiliriz. Fakat bu kullanım şekli pek doğru değildir. Ama sonuç üretir. Sizin uyguladığınız bölüm kırmızı renkli bölümdür. Ben ayrıca tarih görünümü vermek için mavi renkli bölümü ekledim.

Private Sub UserForm_Click()
    TextBox1 = [COLOR=blue]Format([/COLOR][COLOR=red]Evaluate("=TODAY()")[/COLOR][COLOR=blue], "dd.mm.yyyy")[/COLOR]
End Sub

En uygun kullanım şekli olarak aşağıdaki şekilde kullanabilirsiniz.

Private Sub UserForm_Click()
    TextBox1 = Format(Date, "dd.mm.yyyy")
End Sub

 

[manly]

Selamlar,

#13 nolu mesajımdaki dosyayı güncelledim. İncelermisiniz.

Çok teşekkürler hocam...Modül2 de yazdığınız kodu anlayamadım. Nasıl çalışıyor...