SAYIN TARUZ ÜSTADIN GELİŞTİRMİŞ OLDUĞU CONCAT RELATED UYGULAMASINI EKTEKİ ÖRNEĞİME EKLEDİM. SORGU ALANINDA "İŞLEMSOR" SORGUSUNDA ÜÇ ALANIM ([TARİH], [KİŞİ] VE [MALZEME]) VAR. CONCAT RELATED BU ALANLARDAN BİRİNİN ÜZERİNDEN HESAPLAMA YAPIP KİŞİ ADINA FARKLI TARİHLERDE AÇILAN KAYITLARIN MALZEME BİLGİSİ ALANINA DAHA ÖNCE GİRİLEN TÜM VERİLERİN TOPLAMINI YANYANA YAPMAKTADIR. BENİM İSTEDİĞİM İSE TARİH VE KİŞİYE GÖRE MALZEME ALANINI YANYANA SIRALAMA YAPMASIDIR. YARDIMLARINIZI BEKLİYORUM. TŞKLER.
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = " ") As Variant
On Error GoTo Err_Handler
Dim rs As DAO.Recordset
Dim rsMV As DAO.Recordset
Dim strSql As String
Dim strOut As String
Dim lngLen As Long
Dim bIsMultiValue As Boolean
ConcatRelated = Null
strSql = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSql = strSql & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSql = strSql & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
bIsMultiValue = (rs(0).Type > 100)
Do While Not rs.EOF
If bIsMultiValue Then
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
2-)
İŞLEMSOR SORGUSUNU SQL Göster ile açıp;
SELECT İŞLEM.TARİH, İŞLEM.KİŞİ, ConcatRelated("MALZEME","İŞLEM","KİŞİ='" & [KİŞİ] & "' and Day([TARİH]) =" & Day([TARİH]) & " ","",",") AS MALZEME
FROM İŞLEM
GROUP BY İŞLEM.TARİH, İŞLEM.KİŞİ
ORDER BY İŞLEM.TARİH, İŞLEM.KİŞİ;
VBA kodlari ile sunduğunuz yönteminiz çalışmam ve değişik tasarımlar için ilave güzel bir paylaşım olmuş. Bir kez daha teşekkürler. İşime yarayacak ilave kodları hemen arşivledim Teşekkürler. İyi çalışmalar.