在ms access中使用vba组合列值

Question

我有一个名为“联系人”的表。该表有我需要使用的两列：公司（公司名称）和位置（他们所在的县）。 位置可能有多个值，也可能没有，它由用“;”分隔的县名填充，我需要能够遍历这些表记录并执行以下操作：

• 查找任何具有匹配公司价值观的条目
• 检查任何匹配公司条目的位置值是否都相互匹配
• 如果位置值不同，请将该公司的位置值更新为按字母顺序排列的所有找到的不同值的串联列表，并用“;”分隔

我已经尝试了下面的代码（请原谅我的任何格式错误），但最终发生的情况是它重复并填充单元格到最大字符，因为如果位置值不完全相同，它只是添加它直到最后，当它再次击中时，你会看到它的不同。经过反思后，我明白逻辑在哪里失败，但我现在不确定我是否走在正确的道路上，或者我是否应该放弃这个并尝试一种完全不同的方式来做到这一点。任何可能在这里起作用的帮助/示例将不胜感激。

Private Sub Command14_Click()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim holdcomp As String
Dim holdloc As String
Dim holddep

holdcomp = ""
holdloc = ""

Set db = CurrentDb
Set rst = db.OpenRecordset("Contacts")

rst.MoveFirst

Do Until rst.EOF

If holdcomp = "" Then
holdcomp = rst!Company
End If
If holdloc = "" Then
holdloc = rst!Location
End If
If holdcomp = "" Then
holdcomp = rst!Company
End If

If holdcomp = rst!Company And holdloc = rst!Location Then
rst.MoveNext
End If
  
If holdcomp = rst!Company Then
If Not holdloc = rst!Location Then
rst.Edit
rst!Location = holdloc & "; " & rst!Location
rst.Update
holdloc = rst!Location
rst.MoveFirst
End If
End If
rst.MoveNext
Loop

End Sub

Answer 1

考虑这个简单的数据集：

身份证	联系人姓名	公司名称	地点
1	a	x	l;m;p
2	b	y	p;q
3	c	z	l；r
4	d	x	h;j;l

以及合并每个公司地点且不重复的程序。

Sub LocationsCleanUp()
Dim db As DAO.Database
Dim rsCon As DAO.Recordset
Dim rsCom As DAO.Recordset
Dim colLoc As Collection
Dim aryLoc, x, strLoc
Set db = CurrentDb
Set rsCom = db.OpenRecordset("SELECT DISTINCT CompanyName FROM Contacts;")
Do While Not rsCom.EOF
    Set rsCon = db.OpenRecordset("SELECT * FROM Contacts WHERE CompanyName='" & rsCom!CompanyName & "'")
    Set colLoc = New Collection
    Do While Not rsCon.EOF
        aryLoc = Split(rsCon!Location, ";")
        For Each x In aryLoc
            On Error Resume Next
            colLoc.Add x, x
        Next
        rsCon.MoveNext
    Loop
    
    'add code here to sort collection elements
    
    strLoc = ""
    For Each x In colLoc
        strLoc = strLoc & x & ";"
    Next
    'do something with the new string - maybe an UPDATE sql action such as
    'CurrentDb.Execute "UPDATE Contacts SET Location = '" & Left(strLoc, Len(strLoc) - 1) & "' WHERE CompanyName='" & rsCom!CompanyName`
    Debug.Print rsCom!CompanyName, Left(strLoc, Len(strLoc) - 1)
    rsCom.MoveNext
Loop
End Sub

On Error Resume Next

可能不是最佳实践，但这是权宜之计。或者，使用代码检查项目是否已在集合中。这是来自 https://analystcave.com/vba-collection/ 的一个示例，我见过更复杂的。

Function CollectionContains(myCol As Collection, checkVal As Variant) As Boolean
    On Error Resume Next
    CollectionContains = False
    Dim it As Variant
    For Each it In myCol
        If it = checkVal Then
            CollectionContains = True
            Exit Function
        End If
    Next
End Function

有关排序过程，请查看如何对集合进行排序？