如何修改VBA函数使匹配结果以换行方式追加？

修改思路 #

区分首个匹配项与后续匹配项的处理逻辑：

• 首次匹配时直接将C列对应值赋值给结果变量
• 后续匹配时，在已有结果后追加换行符（VBA中用vbLf表示）和新的匹配值
• 移除原代码中Mid(v2,2)的截取操作，因为首个匹配项不再有多余前缀

修改后的完整代码 #

Sub Adrift()
    Dim NA As Long, NC As Long, v As String, I As Long, J As Long
    Dim v2 As String
    Dim isFirstMatch As Boolean ' 新增变量标记是否为首个匹配项
    
    NA = Cells(Rows.Count, "A").End(xlUp).Row
    NC = Cells(Rows.Count, "C").End(xlUp).Row
    
    For I = 2 To NA
        v = Cells(I, "A").Value
        v2 = ""
        isFirstMatch = True ' 每次处理新的A列行时，重置标记
        
        For J = 2 To NC
            If InStr(Cells(J, "C").Value, v) > 0 Then
                ' 替换原拼接逻辑，区分首个匹配与后续匹配
                If isFirstMatch Then
                    v2 = Cells(J, "C").Value
                    isFirstMatch = False
                Else
                    v2 = v2 & vbLf & Cells(J, "C").Value
                End If
            End If
        Next J
        
        Cells(I, "A").Offset(0, 1).Value = v2 ' 直接赋值，无需截取前缀
        Cells(I, "A").Offset(0, 1).WrapText = True ' 自动换行，确保显示效果
    Next I
End Sub

关键修改点说明 #

1. 新增标记变量：isFirstMatch用来记录当前是否是第一个匹配项，每次处理A列新行时重置为True
2. 匹配项拼接逻辑：
   • 首次匹配：直接将C列值赋给v2，并将标记设为False
   • 后续匹配：用vbLf（换行符）连接新的匹配值
3. 移除前缀截取：原代码的Mid(v2,2)是为了去掉首个分号，修改后不再需要，直接赋值v2即可
4. 添加自动换行设置：通过WrapText = True确保单元格内的换行符能正常显示

内容的提问来源于stack exchange，提问作者HelloWorld