Hesaplama (MANUEL-OTOMATIK)

[vivident]

Yapılabilinir mi bilmiyorum, ama şu işlem mümkünmüdür ?

Hazırladığım dosyamda hesaplama yaptırmak istemediğim sheetler var. Hesaplamaya girince bekliyorum, bu beklemeyi önlemek için, Örneğin ;

Dosya içinde A,B,C,D,E sheetleri var. Dosya hesaplaması otomatik olsa bile C,D,E sheetlerinin hesaplamaları manuel olacak. C,D,E sheetlerinin hesaplamalarının otomatik olması için tek şart A sheetinin A1 hücresinde "AKTIF" yazısının olması

Bu mümkünmüdür ?

 

[Ömer]

Merhaba,

Vba bölümünde "Bu çalışma Kitabı" penceresine kopyalayın. Sayfalar arası geçişte kodlar çalışır.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    Dim i As Byte, syf()

    syf = Array("C", "D", "E")

    For i = 0 To UBound(syf)
        If ActiveSheet.Name = syf(i) Then
            If Sheets("A").Range("A1") <> "AKTIF" Then
                Application.Calculation = xlManual
                Exit Sub
            End If
        End If
    Next i
    
    Application.Calculation = xlAutomatic

End Sub

.

 

[vivident]

Ömer bey yeni deneme fırsatım oldu. Aktar makrom var. A sayfasından B sayfasına veri aktarıyor. Veri aktarma işleminde makronun içine "Application.Calculation = xlManual" yazmıştım, sanıyorum onu hiç dikkate almıyor. Bu makroyu nasıl dahil ederiz

Yani amacım, belli sayfalarda otomatik hesaplamalar yapılırken, diğer sayfalardaki formüllerin (çok kasma yaptırıyor) bu hesaplamaları dikkate almaması

Sub Aktar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Arsiv").Unprotect "6551"
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("FORM")
Set s2 = ThisWorkbook.Worksheets("Arsiv")
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
For i = 12 To 23
s2.Cells(sonsatir, 6) = s1.Cells(i, 2)
s2.Cells(sonsatir, 7) = s1.Cells(i, 5)
s2.Cells(sonsatir, 11) = s1.Cells(i, 14)
s2.Cells(sonsatir, 2) = s1.Cells(i, 16)
s2.Cells(sonsatir, 8) = s1.Cells(i, 20)
s2.Cells(sonsatir, 9) = s1.Cells(i, 22)
s2.Cells(sonsatir, 12) = s1.Cells(i, 28)
s2.Cells(sonsatir, 10) = s1.Cells(i, 42)
s2.Cells(sonsatir, 5) = s1.Cells(i, 43)
sonsatir = sonsatir + 1
Next i
Sheets("Arsiv").Select
Application.ScreenUpdating = True
Sheets("Arsiv").Protect "6551"
MsgBox "Veriler Taşınmıştır" & vbLf & _
"TAMAM'ı Tıkladıktan Sonra Lütfen Bekleyiniz", vbInformation
Application.Calculation = xlAutomatic
End Sub

 

[Ömer BARAN]

Benim düşüncem şudur.
Belgenin açılışında hesaplamayı manual hale getirip,
-- ne zaman hesaplama yapılacaksa ya da
-- hangi sayfa için ya da
-- hangi sayfanın hangi hücre aralığı için
hesaplama gerekiyorsa o kısmı yazıp ".Calculate" diye kod satırı eklemek iyi bir çözüm olur.

 

[Ömer BARAN]

Belgenin kod sayfasındaki This Workbook bölümüne;

Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Calculation = xlCalculationAutomatic
End Sub

kodlarını ekledikten sonra
Sizin yazdığınız kodun hangi aşamasında lazımsa o araya, hangi sayfa için, hangi alan için gerekliyse hesaplama yapmasını sağlamak üzere örneğin;

Shetts("A").Calculate

Sheets("A").Range("D7:K15").Calculate

gibi bir satır eklemek çözüm olur diye düşünüyorum.

 

[vivident]

Ömer bey sizin düşünceniz sanıyorum ki benim tek çözüm yolum. Bi kaç denem yaptım, oluyor gibi.

Aşağıdaki kodu kontrol edebilirmisin.
AS10'lu kod çalışıyor, Sanıyorum ki diğer kodda problem var. E12:E25 arasındaki hücreler değişirse B12:B25 ve AQ12:AQ25 hücrelerini hesaplasın. O hücrelerde formüllerim var, ama hesaplamadı. Yanlışlık nerede

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [AS10]) Is Nothing Then Exit Sub
Sheets("FORM").Calculate
Sheets("FormüllerII").Calculate
If Intersect(Target, Range("E12:E25")) Is Nothing Then Exit Sub
Sheets("FORM").Range("B12:B25").Calculate
Sheets("FORM").Range("AQ12:AQ25").Calculate
End Sub

 

[Ömer BARAN]

Örnek dosya olsaydı bakabilirdik.
Zaten kod bilgim zayıf, ezbere bir şey söylemek mümkün görünmüyor (en azından benim açımdan böyle) .

 

[vivident]

Ömer bey dosya ekte.
Dosyayı açınca sizin dediğiniz gibi tüm hesaplamalar manuel oluyor
AS10 hücresinden bir ekip seçin.
Adı soyadı kısmından bir isim secin (sicil B12-B25 ve Uet No AQ-AQ25) formülleri çalışmıyor

Sheets("FORM").Range("B12:B25").Calculate
Sheets("FORM").Range("AQ12:AQ25").Calculate

 

[Ömer BARAN]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("AS10, E12:E25")) Is Nothing Then Exit Sub
Sheets("FORM").Calculate
Sheets("Formüller").Range("B1:H50").Calculate
End Sub

Kodu yukarıdaki gibi değiştirerek deneyiniz.