Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вставка текста из нескольких ячеек в одну (Без формул)
 
#1
18.06.2025 09:36:04
Добрый день, на работе часто сталкиваюсь с проблемой копирования текста из нескольких ячеек и вставки текста в одну.
Формулами делать это не удобно - диапазоны всегда разные. Но когда пытаюсь загуглить мою проблему, весь поиск скатывается в формулы объединения.
Возможно ли сделать какой то макрос, который бы брал данные из буфера обмена и вставлял их в ячейку по подобию формулы сцепить?
То есть задать разделитель запятую и каждая новая ячейка отделялась через альт+энтер в новую строку.

В примере попытался все наглядно показать, в идеале выделять ячейки B2:B4, копировать, выделять ячейку Е2 и нажимать хоткей макроса.
 
 
 
#2
18.06.2025 10:39:06
Добрый день.
Вариант. Выделяете группу ячеек, нажимаете CTRL и выделяете целевую ячейку, куда нужно их сцепить (получается выбор двух областей).
Затем нажимаете кнопку макроса.
 
 
 
#3
18.06.2025 12:19:50
TonyQQ, а так в exel не работает?
 
 
 
#4
18.06.2025 13:15:14
bigorq, К сожалению нет, но именно такой функционал мне и нужен, мб проще использовать другое приложение. Какое вы используете на гифке?

Никита Дворец, Спасибо! Работает как нужно, но я забыл добавить: копирование и вставка происходят в двух разных документах, поэтому ваш макрос не получается применить
 
 
 
#5
18.06.2025 13:23:54
Цитата
TonyQQ написал:
Какое вы используете на гифке?
LibreOffice
 
 
 
#6
18.06.2025 13:27:26
TonyQQ,
Цитата
копирование и вставка происходят в двух разных документах

Если эти файлы Excel не меняют свои имена, то можно настроить макрос.  
 
 
 
#7
18.06.2025 13:29:18
Код
Option Explicit

Sub Вставка()
    Dim rSource As Range
    Set rSource = Selection
    Set rSource = Intersect(rSource, rSource.Parent.UsedRange)
    
    Dim sSource As String
    sSource = GetSourceString(rSource)
    
    Dim rPrint As Range
    Set rPrint = Application.InputBox("Выберите диапазон КУДА:", Type:=8)
    If rPrint Is Nothing Then Exit Sub
    
    rPrint.Cells(1, 1).Value = sSource
End Sub

Private Function GetSourceString(rSource) As String
    Dim arr As Variant
    ReDim arr(1 To rSource.Cells.Count)
    Dim cl As Range, yy As Long
    For Each cl In rSource.Cells
        yy = yy + 1
        arr(yy) = cl.Value
    Next
    GetSourceString = Join(arr, "," & Chr(10))
End Function
 
 
 
#8
18.06.2025 13:48:35
"в идеале выделять ячейки B2:B4, копировать, выделять ячейку Е2 и нажимать хоткей макроса."
Код
Sub PasteData()
  ActiveCell.Value = ReturnData
End Sub
Function ReturnData()
  Dim objCP As Object
  Set objCP = CreateObject("HtmlFile")
  ReturnData = objCP.parentWindow.clipboardData.GetData("text")
  Dim arr As Variant
  arr = Split(ReturnData, Chr(10))
  Do
    If LBound(arr) >= UBound(arr) Then
        Exit Do
    ElseIf arr(UBound(arr)) = "" Then
        ReDim Preserve arr(LBound(arr) To UBound(arr) - 1)
    Else
        Exit Do
    End If
  Loop
  ReturnData = Join(arr, "," & Chr(10))
End Function
 
 
 
#9
20.06.2025 13:12:39
Универсальный макрос на все случай жизни.

Выбираем ячейки, которые нужно перенести по типу «СЦЕПИТЬ». Затем запускаем макрос через кнопку или другим удобным способом. После запуска макрос попросит указать, куда должна появиться информация — выбираем нужное место и готово! =)


Код
Sub Selectmacros()
    Dim selectedRange As Range
    Dim outputCell As Range
    Dim resultString As String
    Dim cell As Range
    
    ' Получаем диапазон выделенных ячеек
    Set selectedRange = Selection
    
    ' Проверяем, выделены ли ячейки
    If selectedRange.Count = 0 Then
        MsgBox "Выберите хотя бы одну ячейку.", vbExclamation
        Exit Sub
    End If
    
    ' Формируем строку из содержимого выбранных ячеек
    For Each cell In selectedRange
        If Len(resultString) > 0 Then
            resultString = resultString & ", "
        End If
        resultString = resultString & Trim(cell.Text)
    Next cell
    
    ' Выбрать ячейку для вывода строки
    On Error Resume Next
    Set outputCell = Application.InputBox("Укажите ячейку для отображения результата:", Type:=8)
    On Error GoTo 0
    
    If Not outputCell Is Nothing Then
        outputCell.Value = resultString
    Else
        MsgBox "Операция отменена.", vbInformation
    End If
End Sub


(resultString = resultString & ", " можете менять на другой символ по желанию.)


Чтобы запустить макрос комбинацией клавиш Alt + Enter, нужно назначить горячие клавиши в настройках Excel.

Чтобы настроить быстрое выполнение макроса:

Назначение горячей клавиши для макроса:
Перейдите во вкладку Файл → Параметры → Настроить ленту.
Кликните внизу окна ссылку «Настройка клавиатуры…» (либо откройте Вид → Макросы → нажмите на значок настроек рядом с полем поиска макросов и выберите пункт Назначить сочетания клавиш).
В появившемся окне найдите категорию макросов (Макросы) и выберите ваш макрос (он называется Selectmacros). Если макрос не появился, убедитесь, что он сохранён в файле рабочей книги (*.xlsm), иначе макрос может быть скрыт.
Поле ввода комбинации клавиш оставьте пустым и введите вручную сочетание клавиш Alt + Enter.
Щёлкните кнопку Назначить и закройте настройки.

Итоговый алгоритм действий:
Выделение нужных ячеек.
Нажатие Alt + Enter для запуска макроса.
Выбор целевой ячейки, куда вставляется результат.


Как-то так )
Изменено: Олег м - 20.06.2025 16:55:28
 
 
 
Страницы: 1
Читают тему
Наверх