S
S
Senseich2021-10-24 15:22:53
excel
Senseich, 2021-10-24 15:22:53

How to remake a cell merge macro?

I am not strong in macros, so I ask for help. I found such a macro, it combines the values ​​of the selected cells into one separated by commas, but it writes the value in the merged cell, i.e. it merges the selected cells and writes the value there. I would like to write down the value in the cell I need. It would be great if you tell me how to rewrite this macro into a function that specifies the cells and ranges of the selected cells. And already this function can be used in the desired cell.

Sub MergeToOneCell()
    Const sDELIM As String = " "     'символ-разделитель
    Dim rCell As Range
    Dim sMergeStr As String
    If TypeName(Selection) <> "Range" Then Exit Sub   'если выделены не ячейки - выходим
    With Selection
        For Each rCell In .Cells
            sMergeStr = sMergeStr & sDELIM & rCell.Text  'собираем текст из ячеек
        Next rCell
        Application.DisplayAlerts = False   'отключаем стандартное предупреждение о потере текста
        .Merge Across:=False                'объединяем ячейки
        Application.DisplayAlerts = True
        .Item(1).Value = Mid(sMergeStr, 1 + Len(sDELIM))    'добавляем к объед.ячейке суммарный текст
    End With
End Sub

Answer the question

In order to leave comments, you need to log in

2 answer(s)
G
Grigory Boev, 2021-10-25
@ProgrammerForever

Selection - this is combined. Pass another Range instead and it will work in the same way
.Item(1).Value - here the value is assigned (to the first cell)
PS : If you need to write to another cell, why merge at all? Just concatenate the values ​​and put them in the cell without concatenating them

A
Anton, 2021-10-29
@KJhas

Function MergeToOneCell(ceSource As Range, ceTarget As Range) as Boolean
Const sDELIM As String = " " ' separator character
Dim rCell As Range
Dim sMergeStr As String
sMergeStr = ""
If ceSouce.Cells.Count = 0 Then MergeToOneCell = False: Exit Function 'if not cells, exit
For Each rCell In ceSource.Cells
sMergeStr = sMergeStr & sDELIM & rCell.Text 'gather text from cells
Next
' Application.DisplayAlerts = False 'disable standard text loss warning
' .Merge Across:=False ' merge cells
' is it not necessary?
'
ceTarget.Item(1).Value = sMergeStr ' summary text
End Function
Sub callMergeToOneCell ()
x = MergeToOneCell("A1:B4", "B5")
End Sub
So?

Didn't find what you were looking for?

Ask your question

Ask a Question

731 491 924 answers to any question