在一个单元格中连接多个值excel vba答案

【问题标题】：Concatenate Multiple values in one cell excell vba在一个单元格中连接多个值excel vba
【发布时间】：2020-02-05 18:00:46
【问题描述】：

我正在使用两本工作簿来搜索缺失的信息，这些信息在一本书中但在另一本书中没有。我的代码有效，但在某些情况下，我返回了多个值，并且只有一个值输入到单元格中，我需要在每个值之间使用“，”将其他值连接到同一个单元格中

  Dim w1 As Worksheet, w2 As Worksheet
  Dim wbnew As Workbook
  Dim c As Range, FR As Variant
  Dim d As Range
  Dim e As Range

  Application.ScreenUpdating = False


  Set w2 = Workbooks("Book2.xlsx").ActiveSheet
  Set w1 = Workbooks("Book1.xlsx").ActiveSheet



For Each c In w1.Range("C2", w1.Range("C" & Rows.Count).End(xlUp))
FR = Application.Match(c, w2.Columns("C"), 0)
If IsNumeric(FR) Then
c.Offset(, 1).Value = w2.Range("D" & FR).Value
End If

Next c

【问题讨论】：

如果您的意思是有多个匹配项，Application.Match 只返回一个匹配项...您将需要一种不同的方法。
谢谢 BigBen，有什么建议吗？我没有意识到应用程序匹配只给出了一个匹配。向你学习很多！
如果您正在处理文本，则可以使用Filter 函数。
不幸的是，过滤功能没有帮助，我有 40 个工作簿需要检查。 VBA 代码会更快。
Filter 是 VBA...你可以点击链接:-)

标签： excel vba concatenation

【解决方案1】：

编辑：测试了这个...

Sub Tester()

    Dim w1 As Worksheet, w2 As Worksheet, c As Range
    Dim arr, r As Long, result As String, sep As String

    Set w1 = Sheet1
    Set w2 = Sheet2

    arr = w2.Range("C2:C" & w2.Cells(Rows.Count, "C").End(xlUp).Row).Resize(, 2).Value

    For Each c In w1.Range(w1.Range("C2"), w1.Cells(Rows.Count, "C").End(xlUp))
        If Len(c) > 0 Then
            result = ""
            sep = ""
            For r = 1 To UBound(arr, 1)
                If arr(r, 1) = c Then
                    result = result & sep & arr(r, 2)
                    sep = ","
                End If
            Next r
            c.Offset(0, 1).Value = result
        End If
    Next c

End Sub

【讨论】：

谢谢，但这导致系统挂起。有没有其他方法可以做到这一点？
你有多少数据？

【解决方案2】：

我能够使用以下代码解决问题。谢谢你们每一个人的帮助！ :)

将 w1 调暗为工作表，将 w2 调暗为工作表 Dim Cl As 范围 Application.ScreenUpdating = False

设置 w2 = Workbooks("Book2.xlsx").ActiveSheet

设置 w1 = Workbooks("Book1.xlsx").ActiveSheet

使用 CreateObject("scripting.dictionary")

  For Each Cl In w2.Range("C2", w2.Range("C" & Rows.Count).End(xlUp))
     If Not .Exists(Cl.Value) Then
        .Add Cl.Value, Cl.Offset(, 1).Value
     Else
        .Item(Cl.Value) = .Item(Cl.Value) & "," & Cl.Offset(, 1).Value
     End If
  Next Cl
  For Each Cl In w1.Range("C2", w1.Range("C" & Rows.Count).End(xlUp))
     If .Exists(Cl.Value) Then Cl.Offset(, 1).Value = .Item(Cl.Value)
  Next Cl
 End With`

【讨论】：