Объединить содержимое 2 ячеек в другую 3-ю ячейку с помощью VBA в Excel

Question

У меня есть две ячейки, скажем: А1 и А2

Содержимое каждого из них представляет собой строку:

А1: Привет

А2: Мир

Моя цель - объединить содержимое A1 и A2 в другой ячейке, например. A3 то есть содержание A3 должно быть:

Hallo World

Я хотел бы сделать это с помощью макроса VBA, а не только для строк в качестве содержимого.

Спасибо вам обоим за ваши ответы !!

Answer 1

Хотя, как говорит MasterMix, этого легче всего достичь формулой, если у вас есть причина, по которой необходимо использовать VBA, это зависит от того, как вы хотите указать ячейки.

Вы можете сделать это как функцию:

Private Function addTwoCells(rngA As Range, rngB As Range) As String
    addTwoCells = rngA & rngB
End Function

Все, что это делает, это копирует (намного быстрее) встроенную функцию конкатенации Excel.

Вы также можете сделать это одним из ста способов в процедуре, вот один способ, который запрашивает у пользователя диапазоны:

Private Sub addTwoCellsProc()
    Dim rngA As String
    Dim rngB As String
    Dim rngOutput As String
    Dim rngTest As Range

    Do
        rngA = InputBox("Please enter first cell address", "Cell A")
        rngA = Range(rngA).Cells(1, 1).Address
        Set rngTest = Intersect(Range(rngA).Cells(1, 1), ActiveSheet.Cells)
    Loop Until Not rngTest Is Nothing

    Do
        rngB = InputBox("Please enter second cell address", "Cell B")
        rngB = Range(rngB).Cells(1, 1).Address
        Set rngTest = Intersect(Range(rngB), ActiveSheet.Cells)
    Loop Until Not rngTest Is Nothing

    Do
        rngOutput = InputBox("Please enter destination cell address", "Output cell")
        Set rngTest = Intersect(Range(rngOutput), ActiveSheet.Cells)
    Loop Until Not rngTest Is Nothing

    Range(rngOutput) = Range(rngA) & Range(rngB)
End Sub

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

Answer 2

Я предлагаю либо формулу Excel

=A1&A2

или макрос VBA

Range("A3").Cell.Value = Range("A1").Cell.Value & Range("A2").Cell.Value

Answer 3

В более общем случае вот макрос, который объединяет любое количество ячеек (даже несмежные блоки ячеек). Примечание: я не включил код, который проверяет отмену пользователя.

Sub G()

    Dim strFinal$
    Dim cell As Range
    Dim rngSource As Range
    Dim rngArea As Range
    Dim rngTarget As Range

    Set rngSource = Application.InputBox("Select cells to merge", Type:=8)
    Set rngTarget = Application.InputBox("Select destination cell", Type:=8)
    For Each rngArea In rngSource
        For Each cell In rngArea
            strFinal = strFinal & cell.Value & " "
        Next
    Next
    strFinal = Left$(strFinal, Len(strFinal) - 1)
    rngTarget.Value = strFinal

End Sub

Answer 4

Это быстрее, просто выберите ячейки, и они объединятся в первую ячейку.

'------------------------------------------------------------------------
' Procedure : Concatenate Text
' Author    : Tim Bennett
' Date      : 11/6/2015
' Purpose   : Concatenate selected text into first column
'------------------------------------------------------------------------
'
'Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)
Sub Concatenate()

Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean

    'Set variables
    Set rOutput = ActiveCell
    bCol = False
    bRow = False

    On Error Resume Next

    'Use current selection
    Set rSelected = Selection

    On Error GoTo 0

    'Only run if cells were selected and cancel button was not pressed
    If Not rSelected Is Nothing Then
        sArgs = "" 'Create string of cell values
        firstcell = ""

        For Each c In rSelected.Cells
            If firstcell = "" Then firstcell = c.Address(bRow, bCol)
            sArgs = sArgs + c.Text + " " 'build string from cell text values

            c.Value = "" ' Clear out the cells taken from
        Next

        'Put the result in the first cell
        Range(firstcell).Value = sArgs



   End If
End Sub