Merge the contents of 2 cells into another 3rd cell using VBA in Excel

后端 未结 4 1095
一整个雨季
一整个雨季 2021-01-20 01:18

I have two cells lets say: A1 and A2

The content of each one of them is a string:

A1: Hallo

A2: World

My goal is to merge the contents of A1

相关标签:
4条回答
  • 2021-01-20 02:05

    In a more general case, here's a macro which concatenates any number of cells (even non-adjacent blocks of cells) Note: I didn't include code which checks user's cancellation.

    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
    
    0 讨论(0)
  • 2021-01-20 02:10

    I suggest either an Excel formula

    =A1&A2
    

    or a VBA macro

    Range("A3").Cell.Value = Range("A1").Cell.Value & Range("A2").Cell.Value
    
    0 讨论(0)
  • 2021-01-20 02:14

    This one is quicker, just select the cells and they are merged into the first cell.

    '------------------------------------------------------------------------
    ' 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
    
    0 讨论(0)
  • 2021-01-20 02:19

    Although, as MasterMix says, this is most easily achieved by a formula, if you have a reason why VBA must be used then it depends on how you wish to specify the cells.

    You could do this as a function:

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

    All this does is replicate the (much faster) built-in Excel concatenate function though.

    You could also do it in one of about a hundred ways in a procedure, here's one way that prompts the user for the ranges:

    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

    You could also use predefined ranges and loop through them if you have multiple ranges to combine. If you explain a bit more about the scenario then someone might provide more specific code.

    0 讨论(0)
提交回复
热议问题