• DİKKAT

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

Çalışma kitabı hesaplama sorunu

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
840
Excel Vers. ve Dili
Office 2016 TR
Merhaba,

Excelde sürekli " Çalışma Kitabı Hesaplama " sorunu yaşamaktayım. Çalışma kitabı her açılışta " Application.Calculation = xlCalculationAutomatic " otomatik aktif edilebilir mi ?

Teşekkür ederim.
 
Merhaba,
Ayarları kontrol ettiniz mi?
211846
 
[TR] Dosya --> Seçenekler --> Formüller --> Hesaplama Seçenekleri yolunu takip ediniz. Otomatik Hesaplama seçilimi?[/TR]
 
Dosya --> Seçenekler --> Formüller --> Hesaplama Seçenekleri yolunu takip ediniz. Otomatik Hesaplama seçilimi?

Her defasında otomatik yapıyorum, ama kendiliğinden el ile seçeneğine geçiyor
 
Eğer kodların içinde Application.Calculation = xlManual böyle bir satır var ise makronun sonlandırılmadan önceki satırlarında ( Exit Sub ve End Sub vs.. ) Application.Calculation = xlAutomatic bu kod olması gerekli yok ise ekleyiniz , eğer yine olmaz ise kodlarınızı ekleyin bakalım.
 
Application.Calculation = xlManual

Dediğiniz gibi ekli ancak yine aynı sorun oluyor.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tr1 As Date, tr2 As Date
Dim s2 As Worksheet, x As Long, tr()
Dim a As Long, p As Long, j As Range, c As Long
Set s2 = Sheets("Günlük Performans")
Application.Calculation = xlCalculationManual
If Target.Row <> 2 Then Exit Sub
If ActiveCell = "" Then Exit Sub
ActiveSheet.Unprotect Password:="33"
tr = Array("15", "28", "41", "54", "67")
x = Target.Column
ay = Split(Trim(ActiveCell.Value), " ")(0)
Set ara = s2.Rows("2:2").Find(ay, , xlFormulas, xlPart, xlByRows, , False, , False)
If ara Is Nothing Then
MsgBox ay & " Tablosu bulunmadı": Exit Sub
Else
For a = 0 To UBound(tr)
Range(Cells(tr(a) + 2, Target.Column + 2), Cells(tr(a) + 10, Target.Column + 10)) = ""
Next
Range(Cells(Target.Row + 2, Target.Column + 2), Cells(Target.Row + 12, Target.Column + 10)) = ""
son = s2.Cells(Rows.Count, "B").End(3).Row
For a = 0 To UBound(tr)
If IsDate(Cells(tr(a), x + 1)) = False Or IsDate(Cells(tr(a), x + 4)) = False Then
MsgBox "Haftaların tarih aralıklarından birinde eksiklik var" & vbCrLf & "İşlem yarım kalacak"
Exit Sub
End If
tr1 = Cells(tr(a), x + 1)
tr2 = Cells(tr(a), x + 4)
f = 1
For Each j In Range(Cells(tr(a) + 2, x + 1), Cells(tr(a) + 8, x + 1))
f = f + 1
For p = 5 To son
If IsDate(s2.Cells(p, ara.Column)) = False Then GoTo 10
If CDate(s2.Cells(p, ara.Column)) >= tr1 And CDate(s2.Cells(p, ara.Column)) <= tr2 And _
UCase(Replace(Replace(Trim(j.Value), "ı", "I"), "i", "İ")) = UCase(Replace(Replace(Trim(s2.Cells(p, ara.Column + 1).Value), "ı", "I"), "i", "İ")) Then
Cells(j.Row, j.Column + 1) = Cells(j.Row, j.Column + 1) + 1 ' Çalışılan Vardiya Sayıs
Cells(j.Row, j.Column + 2) = Cells(j.Row, j.Column + 2) + s2.Cells(p, ara.Column + 2) ' Kişi Sayısı
Cells(j.Row, j.Column + 3) = Cells(j.Row, j.Column + 2) / Cells(j.Row, j.Column + 1) ' Vardiya Başı Ortalama Kişi Sayısı
Cells(j.Row, j.Column + 4) = Cells(j.Row, j.Column + 4) + s2.Cells(p, ara.Column + 6) ' Toplam Çalışma Saat
Cells(j.Row, j.Column + 5) = Cells(j.Row, j.Column + 5) + s2.Cells(p, ara.Column + 21) ' Aktif Çalışma Saat
Cells(j.Row, j.Column + 6) = Cells(j.Row, j.Column + 4) - Cells(j.Row, j.Column + 5) ' Pasif Çalışma Saat
Cells(j.Row, j.Column + 7) = Cells(j.Row, j.Column + 7) + s2.Cells(p, ara.Column + 9) ' Üretilmesi Gereken Koli
Cells(j.Row, j.Column + 8) = Cells(j.Row, j.Column + 8) + s2.Cells(p, ara.Column + 10) ' Üretilen Koli
Cells(j.Row, j.Column + 9) = Cells(j.Row, j.Column + 7) - Cells(j.Row, j.Column + 8) ' Üretilemeyen Koli
'...........
Cells(Target.Row + f, j.Column + 1) = Cells(Target.Row + f, j.Column + 1) + 1 ' Çalışılan Vardiya Sayısı
Cells(Target.Row + f, j.Column + 2) = Cells(Target.Row + f, j.Column + 2) + s2.Cells(p, ara.Column + 2) ' Kişi Sayısı
Cells(Target.Row + f, j.Column + 3) = Cells(Target.Row + f, j.Column + 2) / Cells(Target.Row + f, j.Column + 1) ' Vardiya Başı Ortalama Kişi Sayısı
Cells(Target.Row + f, j.Column + 4) = Cells(Target.Row + f, j.Column + 4) + s2.Cells(p, ara.Column + 6) ' Toplam Çalışma Saat
Cells(Target.Row + f, j.Column + 5) = Cells(Target.Row + f, j.Column + 5) + s2.Cells(p, ara.Column + 21) ' Aktif Çalışma Saat
Cells(Target.Row + f, j.Column + 6) = Cells(Target.Row + f, j.Column + 4) - Cells(Target.Row + f, j.Column + 5) ' Pasif Çalışma Saat
Cells(Target.Row + f, j.Column + 7) = Cells(Target.Row + f, j.Column + 7) + s2.Cells(p, ara.Column + 9) ' Üretilmesi Gereken Koli
Cells(Target.Row + f, j.Column + 8) = Cells(Target.Row + f, j.Column + 8) + s2.Cells(p, ara.Column + 10) ' Üretilen Koli
Cells(Target.Row + f, j.Column + 9) = Cells(Target.Row + f, j.Column + 9) + s2.Cells(p, ara.Column + 11) ' Üretilemeyen Koli
End If
If s2.Cells(p + 1, ara.Column).Value = "" Then Exit For
Next
10:
Next
For Each i In Range(Cells(tr(a) + 9, Target.Column + 3), Cells(tr(a) + 9, Target.Column + 10))
i.Value = Application.Sum(Range(Cells(tr(a) + 2, i.Column), Cells(tr(a) + 8, i.Column)))
Next
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
If IsNumeric(Cells(tr(a) + 9, Target.Column + 7)) = True And IsNumeric(Cells(tr(a) + 9, Target.Column + 5)) = True Then
If Cells(tr(a) + 9, Target.Column + 5) > 0 Then Cells(tr(a) + 10, Target.Column + 5) = Cells(tr(a) + 9, Target.Column + 7) / Cells(tr(a) + 9, Target.Column + 5)
End If
If IsNumeric(Cells(tr(a) + 9, Target.Column + 9)) = True And IsNumeric(Cells(tr(a) + 9, Target.Column + 8)) = True Then
If Cells(tr(a) + 9, Target.Column + 8) > 0 Then Cells(tr(a) + 10, Target.Column + 8) = Cells(tr(a) + 9, Target.Column + 9) / Cells(tr(a) + 9, Target.Column + 8)
End If
Next
End If
For ı = 3 To 10
Cells(Target.Row + 9, Target.Column + ı) = Application.Sum(Range(Cells(Target.Row + 2, Target.Column + ı), Cells(Target.Row + 8, Target.Column + ı)))
Next
Cells(Target.Row + 10, Target.Column + 5) = Cells(Target.Row + 9, Target.Column + 7) / Cells(Target.Row + 9, Target.Column + 5)
Cells(Target.Row + 10, Target.Column + 8) = Cells(Target.Row + 9, Target.Column + 9) / Cells(Target.Row + 9, Target.Column + 8)
Application.Calculation = xlCalculationAutomatic
ActiveSheet.Protect Password:="33"
Cells(Target.Row + 0, Target.Column).Select
End Sub
 
Şu iki satırın arasına da Application.Calculation = xlAutomatic komutunu ekleyiniz.

Kod:
MsgBox "Haftaların tarih aralıklarından birinde eksiklik var" & vbCrLf & "İşlem yarım kalacak"
Exit Sub
 
Geri
Üst