AccessTr.neT

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