Как скопировать содержимое ячейки / нескольких ячеек (в виде текста), чтобы добавить его к существующему тексту в другой ячейке

Question

Моя проблема на самом деле довольно проста, хотя я не могу найти решение, хотя.

например.

В ячейке А у меня есть текст «Яблоки»

В ячейках B C и D у меня есть текст

B = „Bananas“
C = „Pears“
D = „Grapes“

Я хочу выделить ячейки B, C и D и вставить их в A, чтобы получить

A = „Apples, Bananas, Pears, Grapes“

И ячейка A, и ячейки B, C и D меняются, поэтому я не могу объединить / использовать простую функцию объединения, такую ​​как сцепление A & B & C & D.

Функция должна быть аналогична нажатию в соответствующую ячейку, например, B, выбрать слово, нажать CTRL + C, щелкнуть мышью в ячейке A, поместить курсор за «Яблоки» и нажать CTRL + V.

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

У вас есть идеи, как решить эту проблему?

Спасибо!

----

Простая попытка с моей стороны состояла в том, чтобы скопировать диапазон в слово doc, выделить все содержимое в слове doc, скопировать его и затем вставить в ячейку

Option Explicit 

Sub CopyInCell() 

 Sheets("Sheet1").Activate 
 With Selection.Interior 
  .Pattern = xlSolid 
  .PatternColorIndex = xlAutomatic 
  .Color = 5287936 
  .TintAndShade = 0 
  .PatternTintAndShade = 0 
 End With 
 Selection.Copy 
 Windows("Sheet2").Activate 
 SendKeys "{F2}", True 
 Application.SendKeys ("%~"), True 
 Application.SendKeys ("^v"), True 
End Sub

Следующим шагом будет автоматизировать / заставить вставку работать таким образом, чтобы я мог просто выбрать ячейку, в которую вставленный текст должен быть добавлен в конец текста ячейки.

---

Попытка использования метода Pehs в сочетании с переключением рабочих книг

Sub insert_change()

 Dim Concatenated As String
 Dim Cell As Range
 Dim Cell2 As Range
 For Each Cell In Selection.Cells 'go through all cells within the selection
     If Concatenated = vbNullString Then
         Concatenated = Cell.Value 
     Else
         Concatenated = Concatenated & ", " & Cell.Value 
     End If
 Next Cell
 Windows("Book2.xlsx").Activate
 Sheets("A").Activate
 Cell2 = Selection.Cells.Value
 Concatenated = Cell2 & ", " & Concatenated
 Selection.Cells.Value = Concatenated

End Sub

Результатами является ошибка времени выполнения 13, типы не совпадают, в строке

Cell2 = Selection.Cells.Value

В чем может быть причина этого? Когда я переключаюсь вручную на этот лист, я выбираю правильную ячейку.

Спасибо!

Answer 1

Если все ваши ячейки находятся в одном столбце и непрерывно (между ними нет пустых ячеек), вы можете просто использовать:

Selection.Cells(1).Value = Join(WorksheetFunction.Transpose(Selection.Value), ", ")

В качестве альтернативы, если они расположены не непрерывно или подряд, вы можете использовать следующее:

Dim Concatenated As String
Dim Cell As Range
For Each Cell In Selection.Cells 'go through all cells within the selection
    If Concatenated = vbNullString Then
        Concatenated = Cell.Value 'collect the first value
    Else
        Concatenated = Concatenated & ", " & Cell.Value 'concatenate all other values comma separated
    End If
Next Cell

Selection.Cells(1).Value = Concatenated 'write the concatenated string into the first cell of the selection

Обратите внимание, что вам нужно будет выбрать все ячейки A, B, C и D, а затем запустить макрос. Затем он запишет результат в ячейку А.

---

В качестве альтернативы, чтобы записать / добавить его в другую ячейку книги, используйте следующую строку вместо последней строки выше.

Workbooks("Book2").Worksheets("A").Activate 'workbook and worksheet to select from

Dim AppendRange As Range
On Error Resume Next 'if next line throws error then no range was selected
Set AppendRange = Application.InputBox(Prompt:="Select the destination cell to append", Title:="Select", Default:=Selection.Address, Type:=8)
On Error GoTo 0

If Not AppendRange Is Nothing Then
    If AppendRange.Cells.Count > 1 Then 'check if more than one cell was selected
        MsgBox "Only selection of one destination cell is allowed.", vbCritical, "Cannot append"
        Exit Sub
    End If
    AppendRange.Value = AppendRange.Value & IIf(AppendRange.Value <> vbNullString, ", ", vbNullString) & Concatenated
End If

Если вы используете эту альтернативу, вам сначала нужно будет выбрать ячейки исходного листа, а затем запустить макрос. Он спросит пользователя, какой будет ячейка назначения, а затем объединит все значения с назначением.