dilerim işinize yarar
modüle eklenecek fonksiyonların kodu
Maksimum sütun sayısını bulan fonk
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
her sütundaki veriyi alan fonksiyon
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
sorguları yeniden oluşturan kod
Public Function SorguYap()
Dim sql, SqlStn As String
Dim xStnSay, x As Integer
Dim ADO_RS As Object
Sql = "SELECT max(SplitStnSay(nz([DERSLER],''))) FROM dersler_birlesik"
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 & ", SplitVeriBul(nz([DERSLER],'')," & x - 1 & ") AS [DERSLERStn" & CStr(x) & "]"
Next x
Sql = "SELECT id, " & Mid(SqlStn, 2) & " FROM dersler_birlesik;"
CurrentDb.QueryDefs("DrsBol").sql = sql
'hy Union____________________________
SqlStn = ""
For x = 1 To xStnSay
SqlStn = SqlStn & " union all SELECT id, Nz(DERSLERStn" & x & ",'') AS [DERSLERStn] from DrsBol " & _
" where Nz(DERSLERStn" & x & ",'')<>''" & vbCrLf
Next x
Sql = Mid(SqlStn, 11)
'
'hy________________________________________
CurrentDb.QueryDefs("DrsAyir").sql = sql
DoCmd.OpenQuery "DrsAyir"
End Function
DrsAyir sorgusu dersleri satır halinde gösterir
ama şöyle bir sorun tablonuzdaki veriler değişken olduğu için sorgunun güncel olabilmesi için sorgu çalıştırılmadan önce SorguYap fonksiyonunun çağrılması gerek
Not: Bence kurduğunuz 1-1 ilişki sorun çıkarabilir, 2 tablonun da ID alanları otomatik tamsayı, kazara tabloların birinden silinecek veya sadece tablolardan birine eklenecek bir kayıt sisteminizin hatalı işlemesine neden olabilir
