aynı değerleri birleştirme

[oydemir]

Excel bu formülü kullanmaktayım bu formülü access uyulabilir miyim


Sub işlem()
Dim son&, veri
Range("H1:H" & Rows.Count).ClearContents
son = Range("B" & Rows.Count).End(xlUp).Row
veri = Range("B1:E" & son).Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(veri)
.Item(veri(i, 1)) = .Item(veri(i, 1)) & "," & veri(i, 4)
Next i
For i = 1 To UBound(veri)
veri(i, 1) = Mid(.Item(veri(i, 1)), 2)
Next i
For i = 1 To UBound(veri)
.RemoveAll
For Each elem In Split(veri(i, 1), ",")
If elem <> "" Then .Item(elem) = Null
Next elem
veri(i, 1) = Join(.keys)
Next i
Range("H1:H" & son).Value = veri
End With
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[muhasebeciyiz]

Access’te Excel VBA’daki bu mantığı aynı şekilde Range/Cells ile yapmazsın; Bir modüle şu fonksiyonu eklersin

' Modül: modConcat
Public Function ConcatRelated(ByVal Expr As String, ByVal Domain As String, _
                              Optional ByVal Criteria As String = "", _
                              Optional ByVal OrderBy As String = "", _
                              Optional ByVal Delim As String = ",") As String
    Dim rs As DAO.Recordset
    Dim sql As String, out As String
    
    sql = "SELECT " & Expr & " AS X FROM " & Domain
    If Len(Criteria) > 0 Then sql = sql & " WHERE " & Criteria
    If Len(OrderBy) > 0 Then sql = sql & " ORDER BY " & OrderBy
    
    Set rs = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
    Do While Not rs.EOF
        If Not IsNull(rs!X) Then
            out = out & Delim & rs!X
        End If
        rs.MoveNext
    Loop
    rs.Close
    
    If Len(out) > 0 Then out = Mid$(out, Len(Delim) + 1)
    ConcatRelated = out
End Function

1. Sonra sorguda şöyle kullanırsın (örnek):

Tablo adın: T_Veriler
Anahtar alanın: B
Birleştirilecek alanın: E

SELECT t.B,
ConcatRelated("E","T_Veriler","B=" & t.B) AS BirlesikListe
FROM T_Veriler AS t
GROUP BY t.B;

Not: B metinse kriter şöyle olmalı: "B='" & t.B & "'"