SQL kod hızlandırma

[tamer42]

Merhaba,
Aşağıdaki kodda;
1 Nolu safadaki verilere göre 2 nolu sayfadan kriterlere uyan verileri Toplam alarak 1 nolu sayfaya getirmeye çalışıyorum
Dİğer bir deyişle TOPLA.ÇARPIM fonksiyonun yaptığı işlemi yapmaya çalışıyorum.

Yalnız bu şekilde satır-satır işlem yaptığı için çok uzun zaman alıyor,

bu işlemi for .... next döngüsüne girmeden UPDATE ifadesini kullanarak tablomuzda bulunan toplam kayıtları güncellemek mümkün olabilir mi?
iSQL = "Update [1$] SET [Toplam] = " & RS() & "" & _
" WHERE [İş Emri No-1]=" & ie1 & " And [İş Emri No-2]=" & ie2 & " And [Kalite]='" & klt & "'"

bunun benzeri bir sorgu ile hızlandırmak ne derece mümkün olabilir?
teşekkürler,
iyi Çalışmalar.

Sub SumSayfa2()
Dim Con As Object
Dim RS As Object
Dim SH As Worksheet, Arr As Variant
Dim myFile As String
Dim uSQL As String, klt As String
Dim LR As Long, i As Long, ub As Long
Dim ie1 As Variant, ie2 As Variant

Set SH = Sheets("1")

LR = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row

Set Con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")

myFile = ThisWorkbook.FullName

Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
myFile & ";extended properties=""Excel 12.0;Hdr=Yes;IMEX=1"""

ReDim Arr(1 To LR - 1, 1 To 1)

For i = 2 To LR
    ie1 = SH.Range("E" & i)
    ie2 = SH.Range("F" & i)
    klt = SH.Cells(i, "G")

    uSQL = "Select Sum(Miktar2) AS Miktar From [2$]" & _
    " WHERE [İş Emri No-1]=" & ie1 & " And [İş Emri No-2]=" & ie2 & " And [Kalite]='" & klt & "'"
    
    RS.Open uSQL, Con, 3, 1
    
    Arr(i - 1, 1) = RS(0)
    
    RS.Close
' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 klt = ""
ie1 = Empty
ie2 = Empty

Next i

ub = UBound(Arr, 1)

SH.Range("N2").Resize(ub, 1).Value = Arr

Con.Close
Set Con = Nothing:  Set RS = Nothing

Set SH = Nothing

End Sub

 

[tamer42]

Merhaba,
Aşağıdaki kodda;
1 Nolu safadaki verilere göre 2 nolu sayfadan kriterlere uyan verileri Toplam alarak 1 nolu sayfaya getirmeye çalışıyorum
Dİğer bir deyişle TOPLA.ÇARPIM fonksiyonun yaptığı işlemi yapmaya çalışıyorum.

Yalnız bu şekilde satır-satır işlem yaptığı için çok uzun zaman alıyor,

bu işlemi for .... next döngüsüne girmeden UPDATE ifadesini kullanarak tablomuzda bulunan toplam kayıtları güncellemek mümkün olabilir mi?
iSQL = "Update [1$] SET [Toplam] = " & RS() & "" & _
" WHERE [İş Emri No-1]=" & ie1 & " And [İş Emri No-2]=" & ie2 & " And [Kalite]='" & klt & "'"

bunun benzeri bir sorgu ile hızlandırmak ne derece mümkün olabilir?
teşekkürler,
iyi Çalışmalar.

Tekrar merhabalar,
Sayfalar Aynı çalışma kitabında olduğu için Dizi ile Aşağıdaki gibi birçözüm ürettim ama;

Farklı bir dosyadan çekmek isterken tabiki bu yöntem mümkün olmayacaktır.

Set SH = Sheets("1")
Set SH2 = Sheets("2")

SH.Range("M2:Q100000").ClearContents
y = SH.Cells(SH.Rows.Count, "A").End(xlUp).Row
z = SH.Cells(SH2.Rows.Count, "A").End(xlUp).Row

arr = SH.Range("E2:F" & y).Value

With SH2
    Set Rng1 = .Range("P2:P" & z)
    Set Rng2 = .Range("Q2:Q" & z)
    Set Rng3 = .Range("C2:C" & z)
    Set RngTm = .Range("H2:H" & z)
End With

ub = UBound(arr, 1)
ReDim arrTm(1 To ub, 1 To 4)

For i = LBound(arr, 1) To ub
    ie1 = arr(i, 1)
    ie2 = arr(i, 2)
    
' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' '
    For j = 1 To 4
    
        klt = SH.Cells(1, j + 13)
    
        u = Application.WorksheetFunction.SumIfs(RngTm, Rng1, ie1, Rng2, ie2, Rng3, klt)
        
        arrTm(i, j) = u

      u = 0
     klt = ""
    Next j
    
' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' '
ie1 = Empty
ie2 = Empty

SH.Range("M" & i).Formula = "=SUM(N" & i & ":Q" & i & ")"
  
Next i

SH.Range("N2").Resize(ub, 4).Value = arrTm

 

[dost]

Merhaba,

Sub Sum_Sheet2()

Dim RS As Object, Con$, uSQL$
Dim SH As Worksheet
Dim LR As Long
Dim myFile As String
Dim myList1, myList2, myList3

Set SH = Sheets("1")

LR = SH.Cells(SH.Rows.Count, "E").End(xlUp).Row
myFile = ThisWorkbook.FullName

Set RS = CreateObject("ADODB.Recordset")
Con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & myFile & _
      ";Extended Properties=""Excel 12.0;Hdr=YES"""

myList1 = "SELECT [İş Emri No-1] FROM [1$]"
myList2 = "SELECT [İş Emri No-2] FROM [1$]"
'myList1 = Join(Application.Transpose(Sheets("1").Range("E2:E" & LR).Value), ",")    'Bu da olabilir
'myList2 = Join(Application.Transpose(Sheets("1").Range("F2:F" & LR).Value), ",")    'Bu da olabilir
myList3 = "SELECT [Kalite] FROM [1$]"

uSQL = "SELECT Sum(Miktar2) AS Miktar FROM [2$] " & _
        "WHERE [İş Emri No-1] IN (" & myList1 & ") " & _
        "AND [İş Emri No-2] IN (" & myList2 & ") " & _
        "AND [Kalite] In (" & myList3 & ") " & _
        "GROUP BY [İş Emri No-1], [İş Emri No-2], [Kalite] "
      
RS.Open uSQL, Con, 3, 1

SH.Range("N2").CopyFromRecordset RS

RS.Close
Set RS = Nothing:   Set SH = Nothing

End Sub

 

[tamer42]

Merhaba,

Sub Sum_Sheet2()

Dim RS As Object, Con$, uSQL$
Dim SH As Worksheet
Dim LR As Long
Dim myFile As String
Dim myList1, myList2, myList3

Set SH = Sheets("1")

LR = SH.Cells(SH.Rows.Count, "E").End(xlUp).Row
myFile = ThisWorkbook.FullName

Set RS = CreateObject("ADODB.Recordset")
Con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & myFile & _
      ";Extended Properties=""Excel 12.0;Hdr=YES"""

myList1 = "SELECT [İş Emri No-1] FROM [1$]"
myList2 = "SELECT [İş Emri No-2] FROM [1$]"
'myList1 = Join(Application.Transpose(Sheets("1").Range("E2:E" & LR).Value), ",")    'Bu da olabilir
'myList2 = Join(Application.Transpose(Sheets("1").Range("F2:F" & LR).Value), ",")    'Bu da olabilir
myList3 = "SELECT [Kalite] FROM [1$]"

uSQL = "SELECT Sum(Miktar2) AS Miktar FROM [2$] " & _
        "WHERE [İş Emri No-1] IN (" & myList1 & ") " & _
        "AND [İş Emri No-2] IN (" & myList2 & ") " & _
        "AND [Kalite] In (" & myList3 & ") " & _
        "GROUP BY [İş Emri No-1], [İş Emri No-2], [Kalite] "
     
RS.Open uSQL, Con, 3, 1

SH.Range("N2").CopyFromRecordset RS

RS.Close
Set RS = Nothing:   Set SH = Nothing

End Sub

Hocam öncelikle teşekkürler,
Ekli dosyada göreceğiniz gibi, Kalite bilgisini sütundan değil; sabir bir değer olarak aldığımız zaman;
Toplam değeri doğru gelmiyor.
Ekli dosyada Pivot Tablo ile kontrol ettim.

tekrar teşekkürler,
iyi Pazarlar

Kalite = "1.Kalite"

uSQL = "SELECT Sum(Miktar2) AS Miktar FROM [2$] " & _
        "WHERE [İş Emri No-1] IN (" & myList1 & ") " & _
        "AND [İş Emri No-2] IN (" & myList2 & ") " & _
        "AND [Kalite] ='" & Kalite & "' " & _
        "GROUP BY [İş Emri No-1], [İş Emri No-2], [Kalite] "

 

[dost]

Merhaba,

myList1 ve myList2 deki başlıklar ile sayfa 1 deki başlık isimleri farklı, o yüzden sonuç doğru çıkmaz.
1. ve 2. sayfadaki başlık isimlerinde herhangi bir değişiklik yapmadan, yeni bir Rapor isimli sayfa yaratıp, aşağıdaki kodları deneyiniz.

Sub Sum_Sheet2()

Dim rs As Object, Con$, uSQL$
Dim SH As Worksheet
Dim LR As Long
Dim myFile As String
Dim myList1, myList2, myList3
Dim Kalite As String

Application.ScreenUpdating = False

Set SH = Sheets("Rapor")

SH.Cells.Clear

myFile = ThisWorkbook.FullName

Set rs = CreateObject("ADODB.Recordset")
Con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & myFile & _
      ";Extended Properties=""Excel 12.0;Hdr=YES"""

Kalite = "1.Kalite"
    
uSQL = "SELECT t2.[Tarih], t1.[Kalite], t1.[İş Emri No-1], t1.[İş Emri No-2], Sum(t1.Miktar2) AS Miktar  " & _
       "FROM [2$] t1 " & _
       "INNER JOIN [1$] t2 ON t1.[İş Emri No-1] = t2.[İşemri No-1] And " & _
       "t1.[İş Emri No-2] = t2.[İşemri No-2] " & _
       "WHERE t1.[Kalite] ='" & Kalite & "' " & _
       "GROUP BY t2.[Tarih], t1.[İş Emri No-1], t1.[İş Emri No-2], t1.[Kalite]  " & _
       "ORDER BY t2.[Tarih], t1.[İş Emri No-1], t1.[İş Emri No-2]  "
      
      
rs.Open uSQL, Con, 3, 1

SH.Range("A1").Resize(1, 5) = Array("Tarih", "Kalite", "İş Emri No-1", "İş Emri No-2", "Toplam Miktar")
SH.Range("A2").CopyFromRecordset rs
SH.Rows("1").Font.Bold = True
SH.Columns("A").NumberFormat = "dd.mm.yyyy"
SH.Columns("A:E").EntireColumn.AutoFit


rs.Close
Set rs = Nothing:   Set SH = Nothing

MsgBox "Veriler aktarılmıştır..."

Application.ScreenUpdating = True

End Sub

 

[tamer42]

Merhaba,

myList1 ve myList2 deki başlıklar ile sayfa 1 deki başlık isimleri farklı, o yüzden sonuç doğru çıkmaz.
1. ve 2. sayfadaki başlık isimlerinde herhangi bir değişiklik yapmadan, yeni bir Rapor isimli sayfa yaratıp, aşağıdaki kodları deneyiniz.

Sub Sum_Sheet2()


End Sub

Hocam teşekkür ederim, emeğinize sağlık;

myList1 ve myList2 deki başlıklar ile sayfa 1 ve 2 deki başlık isimlerini ekli dosyada aynı hale getirdim, bu dosya üzerinden bakabilir misiinz,
Farklı bir sayfaya verinin gelmesi benim işimi çok görmüyor, bu seferde oradan VLOOKUP ile verileri almak gerekecek.

iyi çalışmalar.

 

[dost]

Merhaba,

#5 nolu mesajımdaki kodları kullanın. Doğru SQL onda.

Eğer illaki sonucun 1 sayfasındaki verilerin E sütununa gelmesini istiyorsanız, diğer uzman arkadaşların konuyla ilgilenmesi doğru olur.

Ben de öğrenmiş olurum.