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]