Goal Seek hk.

[Kumpasta]

İyi günler.
Daha önce yine forum arkadaşlarımızın yardımı ile aşağıdaki makroyu kullanmaya başlamıştım. Farklı bir çalışmada yine bu tarz bir iş lazım oldu.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d32:d" & Cells(Rows.Count, "d").End(3).Row)) Is Nothing Then Exit Sub
son = Cells(Rows.Count, "d").End(3).Row
For i = 29 To son
Cells(i, "U").GoalSeek Goal:=Cells(i, "d"), ChangingCell:=Cells(i, "e")
Cells(i, "e") = Round(Cells(i, "e"), 2)
Next
End Sub

Bu kodu 2 farklı aralıkta çalıştırmak istiyorum.
D32: D43 ve D46: D57 hücreleri için hesaplama yapacak.
Mümkünse bu yardımcı olabilir misiniz?

 

[Kumpasta]

Bir de
bir butona nasıl atayabilirim bu kodları?

 

[Kumpasta]

konu günceldir

 

[hamitcan]

Dosya eklerseniz daha çabuk cevap bulabilirsiniz.

 

[Korhan Ayhan]

Bahsettiğiniz kodu komple siliniz.

Boş bir modüle aşağıdaki kodu uygulayınız. Sonra sayfanıza buton ekleyip makro ata işlemini yapınız.

Option Explicit

Sub GoalSeek_Example()
    Dim Veri As Range
    
    For Each Veri In Range("D32:D43,D46:D57")
        Cells(Veri.Row, "U").GoalSeek Goal:=Veri, ChangingCell:=Cells(Veri.Row, "E")
        Cells(Veri.Row, "E") = Round(Cells(Veri.Row, "E"), 2)
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Kumpasta]

teşekkür ederim efendim saygılar.

 

[Kumpasta]

İyi akşamlar.
Tekrar bu konu ile ilgili sizi rahatsız ediyorum
Küçük bir desteğe daha ihtiyacım var.

Yardım istediğim nokta şu: Ekte ki dosyada hesaplamalar sayfasında yaklaşık 8500 satır 1 personelin 2 yıllık bordro hesaplaması var. Makro belirli rakamları netten bürüte yapmaya çalışıyor. 250 personelin her biri için 24 satır olduğundan dolayı herhangi bir personelde değişiklik olduğunda bütün satırları baştan hesaplamaya çalışıyor ve çok uzun sürüyor. Bazende yılın yarısına kadar hesaplama yapıyor tekrar çalıştırdığımda tamamlıyor?
Sadece değişiklik yaptığımız satırlar için bir hesaplama yaptırabilir miyiz?
Bir de çok aşırı yavaş çalışıyor. Başka mantık yürütebilirmiyiz goalseek ten başka? Sihirli parmaklarınıza ihtiyacım var :}}

Bahsettiğiniz kodu komple siliniz.

Boş bir modüle aşağıdaki kodu uygulayınız. Sonra sayfanıza buton ekleyip makro ata işlemini yapınız.

Option Explicit

Sub GoalSeek_Example()
    Dim Veri As Range
   
    For Each Veri In Range("D32:D43,D46:D57")
        Cells(Veri.Row, "U").GoalSeek Goal:=Veri, ChangingCell:=Cells(Veri.Row, "E")
        Cells(Veri.Row, "E") = Round(Cells(Veri.Row, "E"), 2)
    Next
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Merhum İdris SERDAR]

.

Verileriniz hacimliyse süsten-püsten kaçınmalısınız.

.

 

[Kumpasta]

Çok doğru İdris bey. Sıkıntıya sebep olacaksa herşeyi temizlerim.

 

[Kumpasta]

Tekrar merhaba. Başka bir yol geldi aklıma.
Değişiklik olan satırlarda bu kodu çalıştırma yapabilir miyiz acaba.

sayfa2 de değiştirdiğim hücreye göre hesaplamalar sayfasındaki ilgili satırlar için hesaplama yaparsa bilgisayarı fazla yormayız gibi geliyor.

 

[Kumpasta]

İlkel bir şekilde aşağıdaki kodları birleştirdim.
yarım da olsa işimi gördü. 250 personel için aşağıdaki ni kullanmam doğru olur mu?
bir de For Each Veri In Range("D32:d55") satırını değişkene atayamadım.
Yardımcı olabilirmisiniz?

-----------------------------------------------------------------------------------------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [d32].Value <> [al55].Value Then
Call GoalSeek_Example
End If
End Sub

Sub GoalSeek_Example()
    Dim Veri As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    '------------------------------- hesaplamadan önce maaşın örneğini saklıyor. değişiklik varsa çalıştıracak.
Range("D32").Select
    Selection.Copy
Range("al32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    '------------------------------- maaşında değişiklik olan kişinin 24 aylık hesabını yapıyor.
    For Each Veri In Range("D32:d55")
        Cells(Veri.Row, "U").GoalSeek Goal:=Veri, ChangingCell:=Cells(Veri.Row, "E")
        Cells(Veri.Row, "E") = Round(Cells(Veri.Row, "E"), 2)
    Next
    '-------------------------------
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

 

[Korhan Ayhan]

Şu bölümü;

For Each Veri In Range("D32:d55")

Aşağıdaki gibi değiştirirseniz seçtiğiniz hücrelere göre kod çalışacaktır. Böylece dinamik bir makro elde etmiş olursunuz.

For Each Veri In Selection

 

[Kumpasta]

Korhan bey değişken derken otomatik çalışan makronun hangi hücrede eşit değilse o hücre aralığını aldırmaktan bahsetmiştim.

yani aşağıdaki kısım d32 ile al55 eşit değilse For Each Veri In Range("D32:d55") aralığını hesaplatmak niyetim. herkesi baştan hesaplamak yerine değişiklikleri hesaplayarak süreyi kısaltmaya çalışıyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [d32].Value <> [al55].Value Then
Call GoalSeek_Example
End If
End Sub

Tabii kişi başına bu kadar kodu çoğaltmak ne kadar doğru karar veremedim.

 

[Korhan Ayhan]

Siz dediğim yöntemi bir deneyin.

Önerdiğim kod satırını uygulayın.
Hesaplatmak istediğiniz hücre aralığını seçip kodu çalıştırın. Böylece diğer alanlar etkilenmemiş olacaktır.