AccessTr.neT

Tam Versiyon: Verileri Süzmede Ve Hesaplamada Hata Var
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5
Bu arada vakano alanı neye gore belirleniyor, belli bir şablon var mı?

Yapilan düzenleme ise yaramasa tam olarak hangi formdaki hangi nesne olduğunu da tam olarak belirtmeniz yerinde olur çünkü ıstatistik formundaki liste kutusu tam olarak belirttiğiniz bilgileri vermiyor
Hocam çok teşekkür ederim sorunum verdiğiniz kodlarla çözüldü. Vakana no 112 acil çağrı merkezi tarafından otomatik olarak üretilerek bize veriliyor. Bizim sistemimize düşen bir numara bu sorunu bana göndermiş olduğunuz mesajda bulunan mükerrer vaka nolarını düzelttikten sonra vaka no alnının özelliğini yineleme yok yaparak çözdüm bu şekilde olur mu yoksa başka bir yolu var mı?
VakaNo merkezden geliyorsa merkez mi aynı vakanoyu gönderiyor?
yok hocam bizim arkadaşlar yanlışlıkla vaka noyu yanlış yazmışlar vaka id gibi vaka no da benzersiz bir numara
kayıtları kontrol ettiğimde arkadaşlar aynı vakayı 3-2 kere yazmışlar bir de yanlışlıkla aynı vaka no yu birden fazla vaka ya yazmışlar ben bakıp hepsini de tek tek düzelttim. Şimdi her vaka nodan bir tane var yine aynı hata ile karşılaşmamak adına vaka tablosundaki vaka no alanının özellik kısmını yineleme yok olarak değiştirdim.
çalışmada bazı değişiklikler yaptım bu haliyle daha jızlı gibi geldi
1 - referanslara Microsof AcriveX Data Objects x.x library eklendi
2 - form modülünün en başına
Option Compare Database
Dim tplCksSure, KytCksSure, tplCksMsf, KytCksMsf, tplVrsSure, KytVrsSure As Double
3 - form yüklenirken Olayı (Form_Load) değişti:
Private Sub Form_Load()
    Me.BİRİMKutusu.SetFocus
    TmListeGncl
End Sub
4 - TmListeGncl fonksiyonu değişti
Private Sub TmListeGncl()

Dim RsLstS As Recordset
Dim RsLst As Recordset

Dim MtnSql, MtnKosul, MtnBirim, MtnMadde1, MtnMadde2, MtnMadde3, MtnSureByk, MtnSureKck, MtnBasTrh, MtnBitTrh As String
Dim MtnKosulDlk, MtnBirimDlk, MtnMadde1Dlk, MtnMadde2Dlk, MtnMadde3Dlk, MtnSureBykDlk, MtnSureKckDlk, MtnBasTrhDlk, MtnBitTrhDlk As String
Dim ImYr As Long

ImYr = Me.ActiveControl.SelStart
Me.ActiveControl.Value = Me.ActiveControl.Text
Me.ActiveControl.SelStart = ImYr
  
   MtnBirim = IIf(Len(BİRİMKutusu & "") < 1, "", " and ([İlkgrup_adi] Like '*" & BİRİMKutusu & "*')")
MtnMadde1 = IIf(Len(MADDE1Kutusu & "") < 1, "", " and ([olay_turu] Like '*" & MADDE1Kutusu & "*')")
MtnMadde2 = IIf(Len(MADDE2Kutusu & "") < 1, "", " and ([olay_cins] Like '*" & MADDE2Kutusu & "*')")
MtnMadde3 = IIf(Len(MADDE3Kutusu & "") < 1, "", " and ([vardiya] Like '*" & MADDE3Kutusu & "*')")
     MtnSureByk = IIf(Len(SureUst & "") < 1, "", " and ([CikisSure]>=" & Me.SureUst & "*60)")
     MtnSureKck = IIf(Len(SureAlt & "") < 1, "", " and ([CikisSure]<=" & Me.SureAlt & "*60)")
     MtnBasTrh = IIf(Len(ilk_tarih & "") < 1, "", " and ([olay_tarihi]>=clng(CDate('" & Me.ilk_tarih & "')))")
     MtnBitTrh = IIf(Len(son_tarih & "") < 1, "", " and ([olay_tarihi]<=clng(CDate('" & Me.son_tarih & "')))")

MtnKosul = MtnBirim & MtnMadde1 & MtnMadde2 & MtnMadde3 & MtnSureByk & MtnSureKck & MtnBasTrh & MtnBitTrh

Set RsLst = CurrentDb.OpenRecordset("sorgu1Krt", dbOpenDynaset) 'Me.TümListe.Recordset.OpenRecordset
MtnKosul = Mid(MtnKosul, 5)
RsLst.Filter = MtnKosul

Set RsLstS = RsLst.OpenRecordset
If RsLstS.RecordCount = 0 Then
    Metin1 = ""
    Metin2 = ""
    Metin85 = ""
    Metin92 = ""
    Exit Sub
End If
RsLstS.MoveLast

Set Me.TümListe.Recordset = RsLstS.OpenRecordset
'Hesaplamalar________________________________________________
tplVrsSure = Dsum ("Nz([CikisSure],0)", RsLstS.Name, MtnKosul)
KytVrsSure = RsLstS.RecordCount
Metin2.Value = KytVrsSure
If KytVrsSure <> 0 Then Me.Metin92 = Sny2Sure(tplVrsSure / KytVrsSure) Else Metin92 = ""

'hy varış süre ortalaması 'sadece değer olan kayıtlar için
tplCksSure = Dsum ("Nz([VarisSure],0)", RsLstS.Name, MtnKosul)
KytCksSure = DCount("*", RsLstS.Name, MtnKosul)
If KytCksSure <> 0 Then Me.Metin1 = Sny2Sure(tplCksSure / KytCksSure) Else Metin1 = ""

'hy mesafe ortalaması sadece değer olan kayıtlar için
tplCksMsf = Dsum ("Nz([mesafe],0)", RsLstS.Name, MtnKosul)
KytCksMsf = DCount("*", RsLstS.Name, MtnKosul)
If KytCksMsf <> 0 Then Me.Metin85 = tplCksMsf / KytCksMsf Else Metin85 = ""

'dsum("[mar]",rst.Name) 'recordseti Dsum ile kullanma

End Sub
hesapla ve HesaplaOrt fonksiyonları silinip doğrudan TmListeGncl fonksiyonunun içine alındı
arada gözümden kaçmış bir şeyler olmuş olabilir istatistik formunda hesaplanmamış alan yada çalışmayan bir fonksiyona rastlarsanız düzeltmeye çalışırım.
Not: tablolara dokunmadım yükleyeceğim örnekteki Tabloları silip kendi tablolarınızı eklerseniz sorunsuz çalışması gerek.

Not2: kapatırken sıkıştırma özelliğini aktifleştirdiğim için kapanması zaman alabiliyor isterseniz devre dışı bırakabilirsiniz
TmListeGncl fonksiyonu aşağıdaki gibi daha da sadeleştirilebilir
Private Sub TmListeGncl()

Dim RsLstS As Recordset
Dim RsLst As Recordset

Dim MtnSql, MtnKosul, MtnBirim, MtnMadde1, MtnMadde2, MtnMadde3, MtnSureByk, MtnSureKck, MtnBasTrh, MtnBitTrh As String
Dim MtnKosulDlk, MtnBirimDlk, MtnMadde1Dlk, MtnMadde2Dlk, MtnMadde3Dlk, MtnSureBykDlk, MtnSureKckDlk, MtnBasTrhDlk, MtnBitTrhDlk As String
Dim ImYr As Long

ImYr = Me.ActiveControl.SelStart
Me.ActiveControl.Value = Me.ActiveControl.Text
Me.ActiveControl.SelStart = ImYr
 
  MtnBirim = IIf(Len(BİRİMKutusu & "") < 1, "", " and ([İlkgrup_adi] Like '*" & BİRİMKutusu & "*')")
MtnMadde1 = IIf(Len(MADDE1Kutusu & "") < 1, "", " and ([olay_turu] Like '*" & MADDE1Kutusu & "*')")
MtnMadde2 = IIf(Len(MADDE2Kutusu & "") < 1, "", " and ([olay_cins] Like '*" & MADDE2Kutusu & "*')")
MtnMadde3 = IIf(Len(MADDE3Kutusu & "") < 1, "", " and ([vardiya] Like '*" & MADDE3Kutusu & "*')")
    MtnSureByk = IIf(Len(SureUst & "") < 1, "", " and ([CikisSure]>=" & Me.SureUst & "*60)")
    MtnSureKck = IIf(Len(SureAlt & "") < 1, "", " and ([CikisSure]<=" & Me.SureAlt & "*60)")
    MtnBasTrh = IIf(Len(ilk_tarih & "") < 1, "", " and ([olay_tarihi]>=clng(CDate('" & Me.ilk_tarih & "')))")
    MtnBitTrh = IIf(Len(son_tarih & "") < 1, "", " and ([olay_tarihi]<=clng(CDate('" & Me.son_tarih & "')))")

MtnKosul = MtnBirim & MtnMadde1 & MtnMadde2 & MtnMadde3 & MtnSureByk & MtnSureKck & MtnBasTrh & MtnBitTrh

Set RsLst = CurrentDb.OpenRecordset("sorgu1Krt", dbOpenDynaset) 'Me.TümListe.Recordset.OpenRecordset
MtnKosul = Mid(MtnKosul, 5)
RsLst.Filter = MtnKosul

Set RsLstS = RsLst.OpenRecordset
If RsLstS.RecordCount = 0 Then GoTo 10

RsLstS.MoveLast

Set Me.TümListe.Recordset = RsLstS.OpenRecordset
KytVrsSure = RsLstS.RecordCount

'Hesaplamalar________________________________________________
'hy CikisSure süre ortalaması 'sadece değer olan kayıtlar için
tplVrsSure = Dsum ("Nz([CikisSure],0)", RsLstS.Name, MtnKosul)

'hy varış süre ortalaması 'sadece değer olan kayıtlar için
tplCksSure = Dsum ("Nz([VarisSure],0)", RsLstS.Name, MtnKosul)

'hy mesafe ortalaması sadece değer olan kayıtlar için
tplCksMsf = Dsum ("Nz([mesafe],0)", RsLstS.Name, MtnKosul)
If KytVrsSure <> 0 Then
    Me.Metin1 = Sny2Sure(tplCksSure / KytVrsSure)
    Me.Metin2.Value = KytVrsSure
    Me.Metin85 = tplCksMsf / KytVrsSure
    Me.Metin92 = Sny2Sure(tplVrsSure / KytVrsSure)
Else
10
    Metin1 = ""
    Metin2 = 0
    Metin85 = ""
    Metin92 = ""
End If
'dsum("[mar]",rst.Name)

End Sub
Sayfalar: 1 2 3 4 5