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

---

liste kutularının kapasitesi sınırlıdır o kadar kaydı taşıyamaz o nedenle sorgulu olanları da ekledim