Sorgu Sonu Yuvarlama

1 2
29/03/2022, 08:51

sule_awci

Çok teşekkür ederim hocam. İyi çalışmalar.
29/03/2022, 09:39

sule_awci

hocam  inceledim çok güzel olmuş ellerinize sağlık. fakat şöyle bir durum var ambarı sıfırlamam gerekiyor. sizin attığınızda ambarda üre ve kompoze kalmış görünüyor ben tüm gübreyi dağıtmak istiyorum. şimdiden teşekkürler. İyi çalışmalar
29/03/2022, 18:02

userx

Sayın @sule_awci
Dosya düzenlendi. İndirip inceler misin?
31/03/2022, 09:35

sule_awci

Hocam çok teşekkür ederim elinize emeğinize sağlık.
31/03/2022, 10:55

userx

Sayın @sule_awci
Yaptığım kontrolde ambardaki gübreden fazla çıkışa izin verdiğini tespit ettim. Bunun olmaması için kodları yeniden düzenledim. Eski kodları alttaki kodla değiştirin yada Mesaj#9 daki dosyayı tekrar indirin.

Private Sub Komut0_Click()
DoCmd.SetWarnings False
On Error Resume Next
Dim objSORGU As DAO.QueryDef, strSQL As String
'---------------------------------------------------------------------------------------------------------
strSQL = "SELECT Ciftci.[Kantar Adı], Ciftci.Köyü, Ciftci.Grup, Ciftci.Sıra, Ciftci.[Adı ve Soyadı], Ciftci.[Kota Ton], Round(IIf([ÜRE]=0,0,[KOTA TON]*([ambardaki üre]/DSum(""[Kota Ton]"",""[Ciftci]"")*1000))/50)*50 AS [ÜRE KG], Round(IIf([ÜRE]=0,0,[KOTA TON]*([ambardaki kompoze]/DSum(""[Kota Ton]"",""[Ciftci]"")*1000))/50)*50 AS [KOMPOZE KG], CBS.[HESAP NO] AS TETKİKLER, Ciftci.[TC Kimlik No] " & vbCrLf & _
"FROM SABİTELER, CBS INNER JOIN Ciftci ON CBS.[TC KİMLİK NO] = Ciftci.[TC Kimlik No];"
Set objSORGU = CurrentDb.CreateQueryDef("GÜBRE TEVZİİ LİSTESİ", strSQL)

DoCmd.RunSQL "SELECT [GÜBRE TEVZİİ LİSTESİ].* INTO Tbl_Gubre FROM [GÜBRE TEVZİİ LİSTESİ]"
'---------------------------------------------------------------------------------------------------------
Ure = ((DLookup("[ambardaki üre]", "SABİTELER") * 1000) - Dsum ("[ÜRE KG]", "Tbl_Gubre")) / 50
If Ure > 0 Then
strSQL = "SELECT TOP " & Ure & " Tbl_Gubre.[Kota Ton], Tbl_Gubre.[ÜRE KG], Tbl_Gubre.[TC Kimlik No] " & vbCrLf & _
"FROM Tbl_Gubre ORDER BY Tbl_Gubre.[Kota Ton] DESC , Tbl_Gubre.[TC Kimlik No]"
Set objSORGU = CurrentDb.CreateQueryDef("SrgUre", strSQL)
DoCmd.RunSQL "UPDATE SrgUre SET SrgUre.[ÜRE KG] = [ÜRE KG]+50 WHERE (((SrgUre.[TC Kimlik No])=[Tbl_Gubre].[TC Kimlik No]));"
Else
strSQL = "SELECT TOP " & -Ure & " Tbl_Gubre.[Kota Ton], Tbl_Gubre.[ÜRE KG], Tbl_Gubre.[TC Kimlik No] " & vbCrLf & _
"FROM Tbl_Gubre ORDER BY Tbl_Gubre.[Kota Ton] DESC , Tbl_Gubre.[TC Kimlik No]"
Set objSORGU = CurrentDb.CreateQueryDef("SrgUre", strSQL)
DoCmd.RunSQL "UPDATE SrgUre SET SrgUre.[ÜRE KG] = [ÜRE KG]-50 WHERE (((SrgUre.[TC Kimlik No])=[Tbl_Gubre].[TC Kimlik No]));"
End If
'------------------------------------------------------------------------------------------------------- Kompoze Dağıtım
Kmpz = ((DLookup("[ambardaki kompoze]", "SABİTELER") * 1000) - Dsum ("[KOMPOZE KG]", "Tbl_Gubre")) / 50
If Kmpz > 0 Then
strSQL = "SELECT TOP " & Kmpz & " Tbl_Gubre.[Kota Ton], Tbl_Gubre.[KOMPOZE KG], Tbl_Gubre.[TC Kimlik No] " & _
"FROM Tbl_Gubre ORDER BY Tbl_Gubre.[Kota Ton] DESC , Tbl_Gubre.[TC Kimlik No]"
Set objSORGU = CurrentDb.CreateQueryDef("SrgKompoze", strSQL)
DoCmd.RunSQL "UPDATE SrgKompoze SET SrgKompoze.[KOMPOZE KG] = [KOMPOZE KG]+50 WHERE (((SrgKompoze.[TC Kimlik No])=[Tbl_Gubre].[TC Kimlik No]));"
Else
strSQL = "SELECT TOP " & -Kmpz & " Tbl_Gubre.[Kota Ton], Tbl_Gubre.[KOMPOZE KG], Tbl_Gubre.[TC Kimlik No] " & _
"FROM Tbl_Gubre ORDER BY Tbl_Gubre.[Kota Ton] DESC , Tbl_Gubre.[TC Kimlik No]"
Set objSORGU = CurrentDb.CreateQueryDef("SrgKompoze", strSQL)
  DoCmd.RunSQL "UPDATE SrgKompoze SET SrgKompoze.[KOMPOZE KG] = [KOMPOZE KG]-50 WHERE (((SrgKompoze.[TC Kimlik No])=[Tbl_Gubre].[TC Kimlik No]));"
End If
'-------------------------------------------------------------------------------------------------------- Üre Dağıtım
CurrentDb.QueryDefs.Delete ("GÜBRE TEVZİİ LİSTESİ")
CurrentDb.QueryDefs.Delete ("SrgUre")
CurrentDb.QueryDefs.Delete ("SrgKompoze")
'--------------------------------------------------------------------------------------------------------
DoCmd.OpenReport "GÜBRE TEVZİİ LİSTESİ", acViewPreview
DoCmd.SetWarnings True
End Sub

Kolay gelsin.
1 2