(28/03/2020, 23:25)berduş yazdı: aslında dikkat ederseniz sorgulara da gerek yok
Modüldeki kodlar

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 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

Kodu Seç

Kodu Kopyala

butonun kodu

Private Sub BtnSay_Click()
    
    Dim sql, SqlStn As String
    Dim xStnSay, x As Integer
      
Dim ADO_RS As Object
Set ADO_RS = CreateObject("adodb.recordset")
         Sql = "SELECT  max(SplitStnSay([Alan1])) AS [HstStn] FROM Tablo1"
    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 & ", SplitVeriBul([Alan1]," & x - 1 & ") AS [HstStn" & CStr(x) & "]"
Next x
    Sql = "SELECT Alan1, " & Mid(SqlStn, 2) & " FROM Tablo1;"
    Me.LstStn.ColumnCount = xStnSay
    Me.LstStn.RowSource = sql

'hy Union____________________________
SqlStn = ""
For x = 1 To xStnSay
    SqlStn = SqlStn & " union all SELECT  Nz(SplitVeriBul([Alan1]," & x - 1 & "),'') AS [HstStn] from tablo1 " & _
                      " where Nz(SplitVeriBul([Alan1]," & x - 1 & "),'')<>''" & vbCrLf
Next x
    Sql = Mid(SqlStn, 11)

    Sql = " SELECT [HstStn], count([HstStn]) AS ToplamSayi FROM (" & Sql & ") as Bileske GROUP BY [HstStn] order by count([HstStn]) "
    Me.LstSay.RowSource = sql

End Sub

Kodu Seç

Kodu Kopyala

---

Kontrol kodunu eklemeyi yine unutmuşum)

sql = Mid(SqlStn, 11) buradaki 11 yerine xStnSay +1 olması gerekmiyormu sayma için.Önceki mesajlardada 11 olarak kalmış.