Split Ve Çapraz Sorgu

1 2 3 4 5 6 7
30/03/2020, 00:42

feraz

(29/03/2020, 19:12)alicimri yazdı: Alan1'e 3 karakterden fazla bilgi girince sorun oluyor, yeni kodlar aşağıda.
Kod:
Private Sub Komut0_Click()
Dim dbs As DAO.Database
  Dim rst As DAO.Recordset
   Dim rst2 As DAO.Recordset
    Set dbs = CurrentDb
   sql1 = "SELECT* FROM Tablo1"
   dbs.Execute ("DELETE * FROM Tablo2")
     Set rst = dbs.OpenRecordset(sql1)
    Do While Not rst.EOF
    alan = alan & "," & "#" & rst("aylar") & "," & rst("alan1")
    rst.MoveNext
  Loop
alan = Mid(alan, 2)
alan = Split(alan, ",")
For i = 0 To UBound(alan)
If Left(alan(i), 1) = "#" Then
ay = Mid(alan(i), 2)
Else
dbs.Execute ("INSERT INTO Tablo2 ( aylar, Alan1, Alan2 ) VALUES('" & ay & "', '" & alan(i) & "', " & 1 & ")")
End If
Next
DoCmd.OpenQuery "sor", acViewNormal, acEdit

End Sub
Elinize sağlık süper düşünülüp uygulanmış.Çapraz sorgu en az 3 alan ve bir alandada değer olmasın için uygulanmış kod.Bizler içinde öğretici kodlar olmuş.Bence başka yola gerek yok sayın accessman hocam
30/03/2020, 01:03

accessman

Evet güzel olmuş ama çok kayıtlı (>5000 ) tablolarda ikinci pluşturulan tablo2 20000 kayıtları geçer
30/03/2020, 01:07

feraz

(30/03/2020, 01:03)accessman yazdı: Evet güzel olmuş ama çok kayıtlı (>5000 ) tablolarda ikinci pluşturulan tablo2 20000 kayıtları geçer
End sub öncesine alttaki kodu eklerseniz tablo2 boş olur işlem bitince.

dbs.Execute ("DELETE * FROM Tablo2")
30/03/2020, 02:07

alicimri

(30/03/2020, 01:03)accessman yazdı: Evet güzel olmuş ama çok kayıtlı (>5000 ) tablolarda ikinci pluşturulan tablo2 20000 kayıtları geçer
Denedim 150000 kayıtı 1 dakikada işliyor, 20000 kayıtı 10-15 saniyede işler.
30/03/2020, 09:20

berduş

yeni bir liste kutusu ekledim
sorguları sildim
buton kodu
Private Sub BtnSay_Click()
   
    Dim sql, SqlStn As String
    Dim xStnSay, x As Integer
    Dim ADO_RS As Object

      Sql = "SELECT  max(SplitStnSay(nz([Alan1],''))) AS [HstStn] FROM Tablo1"
Set ADO_RS = CreateObject("adodb.recordset")
    ADO_RS.Open sql, CurrentProject.Connection, 3, 1

xStnSay = ADO_RS(0)
ADO_RS.Close
Set ADO_RS = Nothing

'hy Sorguyu s?tunlara b?l
SqlStn = ""
For x = 1 To xStnSay
    SqlStn = SqlStn & ", splitVeri(nz([Alan1],'')," & x - 1 & ") AS [HstStn" & CStr(x) & "]"
Next x
    Sql = "SELECT aylar,Alan1, " & Mid(SqlStn, 2) & " FROM Tablo1;"
   
    Me.LstStn.ColumnCount = xStnSay + 1
    Me.LstStn.RowSource = sql
   
'hy Union____________________________
SqlStn = ""
For x = 1 To xStnSay
    SqlStn = SqlStn & " union all SELECT  aylar, Nz(splitVeri(nz([Alan1],'')," & x - 1 & "),'') AS [HstStn] from tablo1 " & _
                      " where Nz(splitVeri(nz([Alan1],'')," & x - 1 & "),'')<>''" & vbCrLf
Next x
      Sql = Mid(SqlStn, 11)
sqlLstSay = " SELECT [HstStn], count([HstStn]) AS ToplamSayi FROM (" & Sql & ") as UnionQuery GROUP BY [HstStn]"
   
      Sql = " SELECT aylar,[HstStn], count([HstStn]) AS ToplamSayi FROM (" & Sql & ") as UnionQuery GROUP BY aylar,[HstStn]"
CaprazSql = "TRANSFORM Sum(HstlikSay.ToplamSayi) AS ToplaToplamSayi " & _
            "SELECT Tablo1.aylar " & _
            "FROM (" & Sql & ") as HstlikSay INNER JOIN Tablo1 ON HstlikSay.aylar = Tablo1.aylar " & _
            "GROUP BY Tablo1.aylar " & _
            "PIVOT HstlikSay.HstStn;"
'hy________________________________________
        Me.LstSay.RowSource = sqlLstSay
    Me.LstCapraz.ColumnCount = LstSay.ListCount
      Me.LstCapraz.RowSource = CaprazSql
Modüldeki kodlar
Public Function SplitVeriBul(GVeri As String, GSayi, Optional Ayrac As String = ",") As Variant
    On Error Resume Next
    Dim var As Variant
    Dim GAyrac As String
    GAyrac = Ayrac
    var = Split(GVeri, GAyrac)
    SplitVeriBul = var(GSayi)

End Function

Public Function SplitStnSay(GVeri As String, Optional Ayrac As String = ",") As Integer
    On Error Resume Next
    Dim var As Variant
    Dim GAyrac As String
    GAyrac = Ayrac
    var = Split(GVeri, Ayrac)
    SplitStnSay = UBound(var) + 1
End Function

Public Function splitVeri(GVeri As String, GSayi As Integer, Optional Ayrac As String = ",") As String
    On Error Resume Next
    splitVeri = Split(GVeri, Ayrac)(GSayi)
End Function
[attachment=31914]

liste kutularının kapasitesi sınırlıdır o kadar kaydı taşıyamaz o nedenle sorgulu olanları da ekledim[attachment=31915]
30/03/2020, 09:37

accessman

sn. doç. @berduş yine kısa öz ve güzel çalışan bir kod yazmışsınız
1 2 3 4 5 6 7