Сконцентрируйте две строки в одной ячейке

Question

У меня есть код, который я создал с помощью interent.

Он просматривает список, чтобы найти определенную строку.Затем он берет ячейку столбца B и вставляет ее в другую рабочую книгу.

Но у меня есть две разные строки в списке.каждый раз, когда мой код перезаписывает 1-ю строку.

Я хочу сконцентрировать их, но с запятой между ними.например, [16, 5]

Кто-нибудь может помочь, пожалуйста?

Спасибо

DATA

[C]_GA-M126_ST16_1.5_1      16
[C]_GA-M126_ST16_1.5_2      16
[C]_GA-M126_ST16_1.5_3      16
[C]_GA-M126_ST16_1.5_4      16
[C]_GA-M126_ST16_1.5_159    5
[C]_GA-M126_ST16_1.5_160    5
[C]_GA-M126_ST16_1.5_161    5
[C]_GA-M126_ST16_1.5_162    5

code

Sub POP_LT_UNC()

Dim W_DIP As Workbook

Dim W_PD As Workbook

Dim WDir As String

Dim CTRL As String

Dim PD_CTRL As Long

Dim nRow As Long

Dim I As Long

Dim C As Long

Dim PD_CELL As Range

Dim firstaddress As String

Dim LT_NUM As String

Dim first_LT As String

Dim ALL_LT As String

'=============================
' Set Pointer to WorkSheets
'=============================
WDir = ActiveWorkbook.Path
W_PD_DIR = WDir & ".\_database\POINT-DATA-ALL COLLECTOINS_v2.xlsx"

Set W_DIP = ThisWorkbook

Workbooks.Open (W_PD_DIR)

Set W_PD = Workbooks("POINT-DATA-ALL COLLECTOINS_v2.xlsx")

GDETrow = 17

    Do Until GDETrow = 41

        GDETrow = GDETrow + 1

        With W_PD.Sheets(1).Range("A:A")

        CTRL = W_DIP.Sheets("AFTER_SURVEY").Cells(GDETrow, 2)

            Set PD_CELL = Range("A:A").Find(What:=CTRL)

            If Not PD_CELL Is Nothing Then

                firstaddress = PD_CELL.Address

                Do

                    cRow = PD_CELL.Row

                    LT_NUM = W_PD.Sheets(1).Cells(cRow, 2)

                    Set PD_CELL = .FindNext(PD_CELL)

                    first_LT = LT_NUM

                        ALL_LT = first_LT & ", " & LT_NUM

                        W_DIP.Sheets("AFTER_SURVEY").Cells(GDETrow, 19) = ALL_LT

                Loop While Not PD_CELL Is Nothing And PD_CELL.Address <> firstaddress

            End If

        End With

    Loop

    W_PD.Close

End Sub

Answer 1

Предполагая, W_DIP.Sheets("AFTER_SURVEY").Cells(GDETrow, 19) = ALL_LT - это строка, в которой написан текст, вы можете сделать следующее:

Dim rangeToChange as Excel.Range
Set rangeToChange = W_DIP.Sheets("AFTER_SURVEY").Cells(GDETrow, 19)

If IsEmpty(rangeToChange.Value2) Then
    rangeToChange.Value2 = ALL_LT
Else 'already text in the Cell, add value with comma
    rangeToChange.Value2 = rangeToChange.Value2 & ", " & ALL_LT
End If

Просто замените строку выше с предоставленным кодом.

Это заполнитЯчейка с указанным значением и добавьте запятую, только если в ячейке уже есть значение.

.Value2 используется, чтобы избежать неявного вызова свойства ячейки по умолчанию.