Tablodaki Satırlardaki Karakter Adedi Bulma

1 2 3 4 5 6 7

@feraz bey aşağıdaki kodu dener misiniz? pasif yaptığım ''''''''hy Sorguyu sütunlara böl bloğu normal tabloyu çoklu sütuna çevirmek için



    Dim sql, SqlStn As String

    Dim xStnSay, x As Integer

      Sql = "SELECT  max(SplitStnSay([Alan1])) AS [HstStn] FROM Tablo1"



    CurrentDb.QueryDefs("Sorgu1").sql = sql

xStnSay = DMax("HstStn", "Sorgu1")



''''''''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;"

'''''''    CurrentDb.QueryDefs("Sorgu1").sql = 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 UnionQuery GROUP BY [HstStn]"

    

    CurrentDb.QueryDefs("HstlikSay").sql = sql

    DoCmd.OpenQuery "HstlikSay"



End Sub

(28/03/2020, 21:59)feraz yazdı:
Alıntı:accessmanŞu nokta sayısını bulmaz mı
int count = line.length() - line.replace(".", "").length();
Sayın hocam bu kod Access için değil.Neden ısrar ediyorsunuz.Hata vereceği ap açık.C# gibi dillerde (vb.net hariç) dim count yerine int count gibi kullanılır.Geri kalan kodlar zaten bağırıyor imdat diye denedim gayet doğru sonuç veriyor
For y = 1 To Len(kes)

     If Mid(kes, y, 1) = "," Then say = say + 1

Next

            

say1 = Len(kes) - Len(Replace(kes, ",", ""))

            

MsgBox say & " ; " & say1

Elinize sağlık @berduş hocam süper olmuş.
Bu arada say olayı @accessman hocamızın hastane dosyasına uygulanabilir.Bu union olayına bir türlü kafam basmıyor okadar video izlememe rağmen Bende ayırma için kod hazırlamıştım.Kodu ekleyeyim sizin dosyayı ve benim en son dosyayı ilk mesaja ekleyeyim.

Private Sub Komut0_Click() 'Ayirma

    

    Dim Sql As String, i As Integer

    Dim rs As Recordset, birlestir

    

    Sql = "SELECT  max(SplitStnSay([Alan1])) AS [HsStn1] FROM Tablo1;"

    

    CurrentDb.QueryDefs("Sorgu1").sql = sql

    

    Set rs = CurrentDb.OpenRecordset(sql)

    

    If rs.RecordCount > 0 Then

        For i = 0 To rs(0)

            birlestir = birlestir & ", SplitVeriBul([Alan1]," & i & ") As [Alan " & i + 1 & "]"

        Next

        

        birlestir = Mid(birlestir, 2)

        Sql = "SELECT Alan1," & birlestir & " From Tablo1"

        CurrentDb.QueryDefs("Sorgu1").sql = sql

        DoCmd.OpenQuery "Sorgu1"

  End If

    

    rs.Close

    Set rs = Nothing

    birlestir = vbNullString

    Sql = vbNullString

    

End Sub

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

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

Kontrol kodunu eklemeyi yine unutmuşum)

Konu çözüldüyse çözüm son mesajda olur, ilk mesaj düzenlenmez, değiştirilmez.

(28/03/2020, 23:28)ozanakkaya yazdı: Konu çözüldüyse çözüm son mesajda olur, ilk mesaj düzenlenmez, değiştirilmez.

Tamam silerim dosyaları ilk mesajdaki.Çözüm hangi mesajda olduğunu bulması zor olur yada yanlış dosya indirilelir diye eklemiştim mantıken.
Eklenen konu dosyasını silmemiştim.

1 2 3 4 5 6 7