Конкатенация нескольких значений в одной ячейке превосходит vba

Question

Я использую две рабочие книги для поиска недостающей информации, которая находится в одной книге, но отсутствует в другой. Мой код работает, но в некоторых случаях у меня есть несколько возвращаемых значений, и в ячейку вводится только одно значение, мне нужно объединить другие значения в одну и ту же ячейку с "," между каждым значением

  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

Answer 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

Answer 2

Мне удалось решить проблему с помощью следующего кода. Спасибо всем за вашу помощь! :)

Dim w1 как рабочая таблица, w2 как рабочая таблица Dim Cl как диапазон Application.ScreenUpdating = False

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

Set 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`