SQL subquery

Katılım
15 Mart 2005
Mesajlar
353
Excel Vers. ve Dili
Microsoft 365 En 64 Bit
Altın Üyelik Bitiş Tarihi
20-03-2024
Merhaba,

Ekli dosyada Data isimli sayfam mevcut.

Sonuc sayfasına istediğim sonuç mevcut.

SQL ile bu sonucu nasıl alabilirim.

Şimdiden cevap verecek arkadaşlara teşekkür ederim.

Aşağıdaki hesaplama mantığı ile inşallah istediğimi anlatabilmişimdir.

Hesaplama mantığı:

Kod:
GY_Tutar  'Hesaplama şekli
if KayitTrh <= yilsonu Then
     GY_Tutar = GY_Tutar + IIF(BA="B"), Tutar, -Tutar)   'yilsonu değişkeninden <= KayitTrh ve BA= "B" ise toplayacak, BA="A" çıkaracak
Else
     if BA = "C" Then
           GY_Tutar = GY_Tutar +  (-Tutar)      'yilsonu değişkeninden > KayitTrh ve BA= "C" ise çıkaracak. Bu işem  GY_Tutar <=0 olana kadar devam edecek. GY_Tutar < 0' dan olduğunda bu tutarı CY_Tutar -'ın ilgili satırına toplayacak. ve GY_Tutar sıfırlanacak.
     End if
End if
'Yukarıdaki işlem MusID ve PB bazında olacak.

CY_Tutar 'Hesaplama şekli
if KayitTrh > yilsonu Then
      if BA = "B" Then  
           CY_Tutar = CY_Tutar + Tutar   'yilsonu değişkeninden > KayitTrh ve BA= "B" ise toplayacak.
     Else
           if  GY_Tutar => 0 Then
                CY_Tutar = CY_Tutar +  (-Tutar)      'yilsonu değişkeninden > KayitTrh ve BA= "C" ise çıkaracak.
           Else
                CY_Tutar = CY_Tutar +  (-Tutar)  + GY_Tutar     'yilsonu değişkeninden > KayitTrh ve BA= "C" ise çıkaracak.  GY_Tutar <0 ise bu tutar toplanacak.
     End if
End if
'Yukarıdaki işlem MusID ve PB bazında olacak.

GY_KurF
'GY_Tutar ile  aynı mantıkta olacak. Tutar sütunu yerine KurF sütunu kullanılacak.  GY_Tutar < 0 olduğu satırda (KurF/Tutar) * GY_Tutar'ın sıfır olmadan önceki tutar
'CY_Tutar ile  aynı mantıkta olacak. Tutar sütunu yerine KurF sütunu kullanılacak.  GY_Tutar < 0 olduğu satırda (KurF/Tutar) * Tutar - GY_Tutar'ın sıfır olmadan önceki tutar
'Yukarıdaki işlem MusID ve PB bazında olacak.
 
Katılım
15 Mart 2005
Mesajlar
353
Excel Vers. ve Dili
Microsoft 365 En 64 Bit
Altın Üyelik Bitiş Tarihi
20-03-2024
Merhaba,

Aşağıdaki şekilde yapabildim.

Ancak ADODB bağlantısı ile INSERT ve UPDATE kodları çalışmadığından birkaç kez sonuçları sayfaya yazdırıp tekradan o sayfayı Tablo olarak aldım.
Aslında souçları TMP tablo yaratıp oraya INSERT edip tekrar o TMP tablodan sonuçları alabilseydim. Daha iyi olurdu yada tek bir SQLŞ ile halledebilsyedim.

Data Sayfası ekli excel dosyasında mevcut.

KFDeg_Detay ve KFDeg_Icmal isimli sayfalar yaratılacak.



Kod:
Sub Kur_Farki_Bul()

Dim yilsonu As Date
Dim cn As Object, rs As Object, rs2 As Object
Dim sql, sql2
Dim kontrol As Boolean


Application.ScreenUpdating = False
On Error GoTo myErr:


sonsat1 = Sheet1.Cells(65536, "A").End(xlUp).Row
sonsat3 = Sheet1.Cells(65536, "A").End(xlUp).Row

yilsonu = DateSerial(Year(Date), 1, 0)

Set cn = CreateObject("ADODB.Connection")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & ThisWorkbook.FullName & _
                ";Extended Properties='Excel 12.0 Macro;HDR=YES'"


Sheet3.Range("A1").CurrentRegion.ClearContents

'Cari yıl kayıtlarını bulur
sql = "Select t1.* , " & _
            "0 AS GY_Tutar, " & _
            "IIF(KayitTrh > DateValue('" & yilsonu & "'), IIF(BA = 'B', Tutar, -Tutar)) AS CY_Tutar, " & _
            "0 AS GY_KurF, " & _
            "IIF(KayitTrh > DateValue('" & yilsonu & "'), IIF(BA = 'B', KurF, -KurF)) AS CY_KurF " & _
      "From [Data$] t1 " & _
      "Where " & _
      "KayitTrh > DateValue('" & yilsonu & "') " & _
      "Order By MusID, PB, KayitTrh "
      
'Geçmiş yıllara ait MusID ve PB bazında toplam alır
sql2 = "Select MusID, MusAdi, PB, GYToplam " & _
       "From ( " & _
            "Select MusID, MusAdi, PB, " & _
                    "SUM(IIF(BA = 'B', Tutar, -Tutar)) As GYToplam " & _
            "From " & _
            "[Data$] " & _
            "Where " & _
            "KayitTrh <= DateValue('" & yilsonu & "') " & _
            "Group By MusID, MusAdi, PB " & _
            ") a " & _
            "Order By MusID, PB "
            
Set rs = cn.Execute(sql)
Set rs2 = cn.Execute(sql2)

Sheet3.Activate
Sheet3.Range("A2").CopyFromRecordset rs   'Cari yıl kayıtlarını KFDeg_Detay sayfasına alır


For i = 0 To rs.Fields.Count - 1
    Sheet3.Cells(1, i + 1) = rs.Fields.Item(i).Name
Next i

sat = 2:   bakiye = 0
rs.MoveFirst
rs2.MoveFirst

'Cari yıl ödemelerini geçmiş yıl borçlarından borç sıfırlanıncaya kadar düşer
Do While Not rs2.EOF     ' No of records in rs2
    bakiye = rs2(3)
    Do While Not rs.EOF  ' No of records in RS
        If (rs(1) = rs2(0) And rs(6) = rs2(2)) Then
            If rs(4) = "A" Then
                If (bakiye + rs(9)) < 0 Then
                    Sheet3.Cells(sat, "I") = bakiye * -1
                    Sheet3.Cells(sat, "J") = (bakiye + rs(9))
                    Sheet3.Cells(sat, "K") = Round((rs(11) / rs(5)) * bakiye, 2)
                    Sheet3.Cells(sat, "L") = rs(11) - Round((rs(11) / rs(5)) * bakiye, 2)
                    bakiye = 0
                Else
                    Sheet3.Cells(sat, "I") = rs(9)
                    Sheet3.Cells(sat, "J") = 0
                    Sheet3.Cells(sat, "K") = rs(11)
                    Sheet3.Cells(sat, "L") = 0
                    bakiye = bakiye - rs(5)
                End If
            End If
            rs.MoveNext
            sat = sat + 1
        Else: Exit Do
        End If
    Loop
    rs2.MoveNext
Loop

sonsat3 = Sheet3.Cells(65536, "A").End(xlUp).Row
'Sheet3.Range("A1:A" & sonsat3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Set rs = Nothing:   Set sql = Nothing
Set rs2 = Nothing: Set sql2 = Nothing

'Geçmiş yıla ait kayıtlar ile Düzeltilmiş cari yıl kayıtlarını birleştirir
sql = "Select s.* " & _
      "From " & _
      "(Select t1.* , " & _
            "IIF(KayitTrh <= DateValue('" & yilsonu & "'), IIF(BA = 'B', Tutar, -Tutar)) AS GY_Tutar, " & _
            "0 AS CY_Tutar, " & _
            "IIF(KayitTrh <= DateValue('" & yilsonu & "'), IIF(BA = 'B', KurF, -KurF)) AS GY_KurF, " & _
            "0 AS CY_KurF " & _
      "From [Data$] t1 " & _
      "Where " & _
      "KayitTrh <= DateValue('" & yilsonu & "') " & _
      "Order By MusID, PB, KayitTrh " & _
      "Union " & _
      "Select * from [KFDeg_Detay$] t2) s " & _
      "Order By s.MusID, s.KayitTrh, s.PB"
      

Set rs = cn.Execute(sql)

Sheet3.Range("A1").CurrentRegion.ClearContents
      
For i = 0 To rs.Fields.Count - 1
    Sheet3.Cells(1, i + 1) = rs.Fields.Item(i).Name
Next i

Sheet3.Range("A2").CopyFromRecordset rs    'Birleşmiş kayıtları KFDeg_Detay sayfasına alır

Set rs = Nothing:   Set sql = Nothing

Sheet1.Range("A1").CurrentRegion.ClearContents

'Birleşmiş kayıtları cari ve PB bazında gruplar
sql = "Select MusID, MusAdi, PB, GD_TutarBak, CD_TutarBak, GD_KurfBak, CD_KurfBak  " & _
       "From ( " & _
            "Select MusID, MusAdi, PB, " & _
                    "SUM(IIF(GY_Tutar IS NULL, 0, GY_Tutar)) As GD_TutarBak, " & _
                    "SUM(IIF(CY_Tutar IS NULL, 0, CY_Tutar)) As CD_TutarBak, " & _
                    "SUM(IIF(GY_KurF IS NULL, 0, GY_KurF)) As GD_KurfBak, " & _
                    "SUM(IIF(CY_KurF IS NULL, 0, CY_KurF)) As CD_KurfBak " & _
            "From " & _
            "[KFDeg_Detay$] " & _
            "Group By MusID, MusAdi, PB " & _
            ") a " & _
            "Order By a.MusID, a.PB "

Set rs = cn.Execute(sql)

Sheet1.Range("A2").CopyFromRecordset rs     'Gruplanmış kayıtları KFDeg_Icmal sayfasına alır

For i = 0 To rs.Fields.Count - 1
    Sheet1.Cells(1, i + 1) = rs.Fields.Item(i).Name
Next i

rs.Close
cn.Close

Set rs = Nothing:   Set sql = Nothing
Set cn = Nothing

Application.ScreenUpdating = True

msg = MsgBox("Bilgiler KFDeg_Detay ve KFDeg_Icmal sayfasına aktarılmıştır...", vbExclamation, "DİKKAT !")

ActiveSheet.Range("A1").Select

Exit Sub
myErr:
  If Err.Number <> 0 Then MsgBox Err.Description
  
End Sub
 
Üst