Как переделать макрос объединения ячеек?

Question

[Senseich]

В макросах я не силен, поэтому прошу помочь. Нашел такой макрос, он объединяет значения выделенных ячеек в одну через запятую, но он записывает значение в объединенной ячейке, т.е. он объединяет выделенные ячейки и записывает туда значение. Я бы хотел записывать значение в нужной мне ячейке. Было бы здорово, если подскажете, как этот макрос переписать в функцию, в которой указываются ячейки и диапазоны выделенных ячеек. И уже данную функцию можно использовать в нужной ячейке.

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

Comments

[Senseich]

John Smith, я если честно полный ноль в макросах, просто нашел в интернете его, он делает то что мне нужно, но мне нужен результат в отдельной ячейке

[Senseich]

John Smith, нет у меня комп слабенький, на нем только 2010 шустро работает. Я уже нашел, вот такую функцию, вставляется в нужную ячейку с указанием нужного диапазона или ячеек выборочно, второй параметр разделитель =ampersand((нужный диапозон/ячейки);", ").

А в макросах такая запись вставляется

Function ampersand(rRange As Range, Optional txt$ = "; ") As String
Dim rCell As Range
    For Each rCell In rRange
        If rCell.Value <> "" Then
            ampersand = ampersand & Trim(rCell.Value) & txt
        End If
    Next
ampersand = Left(ampersand, Len(ampersand) - Len(txt))
End Function

[Григорий Боев]

Senseich, про что я и говорил - тут объединение только лишняя операция

Answer 1

[Григорий Боев]

Selection - это объдиняется. Передайте вместо него другой Range и отработает так же
.Item(1).Value - тут присваивается значение (в перувю ячейку)
PS: Если надо в другую ячейку писать, за зачем вообще объединять? Просто конкатенируйте значения и кладите в ячейку без их объединения

Comments

[Senseich]

Григорий Боев честно, представления не имею, про что вы ) я в эксель макросах ничего не понимаю, просто нашел его в интернет, мне надо чтобы он делал то что делает, но рез-тат записывал в указанную ячейку. Если можно проще сделать, буду рад, если подскажете как?

Answer 2

[Антон]

Function MergeToOneCell(ceSource As Range, ceTarget As Range) as Boolean
Const sDELIM As String = " " 'символ-разделитель
Dim rCell As Range
Dim sMergeStr As String
sMergeStr = ""
If ceSouce.Cells.Count = 0 Then MergeToOneCell = False: Exit Function 'если не ячейки - выходим
For Each rCell In ceSource.Cells
sMergeStr = sMergeStr & sDELIM & rCell.Text 'собираем текст из ячеек
Next
' Application.DisplayAlerts = False 'отключаем стандартное предупреждение о потере текста
' .Merge Across:=False 'объединяем ячейки
' это не надо?
' Application.DisplayAlerts = True
ceTarget.Item(1).Value = sMergeStr ' суммарный текст
End Function

Sub callMergeToOneCell ()
x = MergeToOneCell("A1:B4", "B5")
End Sub

Так?