- Katılım
- 11 Mart 2005
- Mesajlar
- 3,189
- Excel Vers. ve Dili
- Office 2013 İngilizce
Merhabalar,
Ekli dosyada verilerin bulunduğu 3 adet sayfa bulunmakta;
"TEK ÖDEME", "ÇİFT ÖDEME", "KONSİNYE"
bu sayfalardaki verileri Rapor olarak çekmek için; ekli dosya Rapor sayfasında olduğu gibi verileri çekmek istiyordum, bunu aşağıdaki iki farklı prosedür ile yaptım.
Önce "getData" SQL sorgusuyla Data sayfasına yukarından aşağıya çektim, Data sayfasından sonra "OrganizeData" prosedürü ile Rapor sayfasına aldım.
Bu işlemi tek adımda SQL sorgusuyla yapabilmenin bir yolu var mıdır?
Desteğiniz için şimdiden teşekkürler,
iyi Çalışmalar dilerim.
Ekli dosyada verilerin bulunduğu 3 adet sayfa bulunmakta;
"TEK ÖDEME", "ÇİFT ÖDEME", "KONSİNYE"
bu sayfalardaki verileri Rapor olarak çekmek için; ekli dosya Rapor sayfasında olduğu gibi verileri çekmek istiyordum, bunu aşağıdaki iki farklı prosedür ile yaptım.
Önce "getData" SQL sorgusuyla Data sayfasına yukarından aşağıya çektim, Data sayfasından sonra "OrganizeData" prosedürü ile Rapor sayfasına aldım.
Bu işlemi tek adımda SQL sorgusuyla yapabilmenin bir yolu var mıdır?
Desteğiniz için şimdiden teşekkürler,
iyi Çalışmalar dilerim.
Kod:
Sub getData()
Dim RS As Object
Dim QRY As String
Dim SQL As String
Dim x As Integer
Dim baslik As Variant
Dim fields As String
Baglan
SHT.Cells.ClearContents
arrSht = Array("TEK ÖDEME", "ÇİFT ÖDEME", "KONSİNYE")
fields = "Format([TARİH], 'dd.mm.yyyy') AS TARİH,[SATICI AD], SUM([KONSİNYE NET]) AS TOPLAM_KONSİNYE_NET"
QRY = "Where [TARİH] is Not Null Group By [TARİH], [SATICI AD]"
SQL = "SELECT " & fields & ",'" & CStr(arrSht(0)) & "' AS SAYFA From [" & arrSht(0) & "$A2:E] " & QRY
SQL = SQL & "Union ALL SELECT " & fields & ",'" & CStr(arrSht(1)) & "' AS SAYFA From [" & arrSht(1) & "$A2:E] " & QRY
SQL = SQL & "Union ALL SELECT " & fields & ",'" & CStr(arrSht(2)) & "' AS SAYFA From [" & arrSht(2) & "$A2:E] " & QRY
Set RS = Con.Execute(SQL)
SHT.Range("A2").CopyFromRecordset RS
x = 1
For Each baslik In RS.fields
SHT.Cells(1, x) = baslik.Name
x = x + 1
Next baslik
QRY = ""
SQL = ""
Set RS = Nothing
''OrganizeData
MsgBox "İşlem Tamam!", vbInformation, "Bilgi"
End Sub
Kod:
Sub OrganizeData()
Dim SH As Worksheet
Dim myRange As Range, Rng3 As Range
Dim Rng1 As Range, Rng2 As Range
Dim tarih As Variant, isim As String
Dim LastRow As Long, i As Long
Dim deger As String, sonuc As Variant
Dim coll As New Collection
''Set SHT = ThisWorkbook.Sheets("Data")
Set SH = ThisWorkbook.Sheets("Rapor")
SH.Range("A2:F100000").ClearContents
''arrSht = Array("TEK ÖDEME", "ÇİFT ÖDEME", "KONSİNYE")
LastRow = SHT.Cells(SHT.Rows.Count, "A").End(xlUp).Row
Set myRange = SHT.Range("C2:C" & LastRow)
Set Rng1 = SHT.Range("A2:A" & LastRow)
Set Rng2 = SHT.Range("B2:B" & LastRow)
Set Rng3 = SHT.Range("D2:D" & LastRow)
On Error Resume Next
For i = 2 To LastRow
deger = CStr(SHT.Cells(i, 1).Value & "|" & SHT.Cells(i, 2).Value)
coll.Add deger, deger
Next i
On Error GoTo 0
For i = 2 To coll.Count
sonuc = Split(coll(i), "|")
isim = sonuc(1)
tarih = Format(CDate(sonuc(0)), "dd.mm.yyyy")
SH.Cells(i, 1).Value = tarih
SH.Cells(i, 2).Value = isim
With Application.WorksheetFunction
SH.Cells(i, 3).Value = .SumIfs(myRange, Rng1, tarih, Rng2, isim, Rng3, arrSht(0))
SH.Cells(i, 4).Value = .SumIfs(myRange, Rng1, tarih, Rng2, isim, Rng3, arrSht(1))
SH.Cells(i, 5).Value = .SumIfs(myRange, Rng1, tarih, Rng2, isim, Rng3, arrSht(2))
End With
isim = ""
sonuc = Empty
Next i
Set coll = Nothing
Set Rng1 = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
Set myRange = Nothing
Set SH = Nothing
End Sub