Страницы: 1
RSS
Как разбить текст в ячейки внесенный через ALT+ENTER
 
Здравствуйте подскажите пожалуйста. Как можно разбить текст в ячейки внесенный через ALT+ENTER, как у меня в примере
 
Если разово и руками, то можно заменить автозаменой "ctrl+enter" на какой-нибудь невстречающийся в тексте значок типа @ & Потом по этому значку разбить по столбцам. И можно макрорекордером записать эти действия, если требуется повторение.
 
Скачайте файл, нажмите Alt+F8 - Выполнить

Код
Sub TestSplit()
Dim LastRow As Long, iRow As Long, arr

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For iRow = 3 To LastRow
            arr = Split(.Cells(iRow, "B"), vbLf, , vbTextCompare)
            .Cells(iRow, "D").Resize(1, UBound(arr) + 1).Value = arr
        Next iRow
    End With
End Sub
Изменено: New - 13.10.2021 15:18:32
 
А формулой можно?
 
New, а почему vbTextCompare? Перенос же не имеет регистра…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Просто так, можно удалить (по привычке, что касается текста ставлю vbTextCompare)
 
Ребят, подскажите как формулой, это сделать?
 
Код
D4:G4           =ЕСЛИОШИБКА(НАЙТИ(СИМВОЛ(10);$B3;C4+1);ДЛСТР($B3))
D3:G3           =ПСТР($B3;C4+1;D4-C4)
 
New, я думал, мож фича какая, а то так ведь больше писать))) понял  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
=MID(SUBSTITUTE(SUBSTITUTE(CHAR(10)&$B5;CHAR(10);REPT(" ";LEN($B5));COLUMNS($D5:D5));CHAR(10);REPT(" ";LEN($B3));1);LEN($B5);LEN($B5))
По вопросам из тем форума, личку не читаю.
 
Ребята и модераторы извиняйте, что так спрошу, мне это формула нужна для того, чтобы можно было перенести данные из ячейки в Word, но проблема в том, что более 255 символов не переносит, подскажите может кто то знает, вот код
Код
Sub ReplaceInWord()
    'имя шаблона Word с основным текстом и метками
    Const sWDTmpl As String = "Шаблон.docx"
      
    Dim objWrdApp As Object, objWrdDoc As Object, wdRange As Object
    Dim IsNeedClose As Boolean
    Dim ws As Worksheet
    Dim lr As Long, llastr As Long, lc As Long, llastc As Long
    Dim sPath As String, sToSavePath As String, sWDTmplFullName As String, sWDDocName As String
    Dim sFindVal As String, sReplaceVal As String
    On Error Resume Next
    'пытаемся подключится к объекту Word
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        'если приложение закрыто - создаем новый экземпляр
        Set objWrdApp = CreateObject("Word.Application")
        'делаем приложение видимым. По умолчанию открывается в скрытом режиме
        objWrdApp.Visible = True
        IsNeedClose = True
    End If
    'путь к папке с файлом кода
    'здесь же должен лежать файл шаблона Word
    sPath = ThisWorkbook.Path
    'добавляем разделитель папок, если его нет
    sPath = IIf(Right(sPath, 1) = Application.PathSeparator, "", sPath & Application.PathSeparator)
    'полный путь к файлу шаблона
    sWDTmplFullName = sPath & sWDTmpl
    'создаем папку для сохранения создаваемых файлов Word
    sToSavePath = sPath & Format(Now, "YYYY_MM_DD hh_mm")
    If Dir(sToSavePath, 16) = "" Then
        MkDir sToSavePath
    End If
    sToSavePath = IIf(Right(sToSavePath, 1) = Application.PathSeparator, "", sToSavePath & Application.PathSeparator)
      
    Set ws = Sheets("Word(копировать)")
    With ws
        'определяем последнюю заполненную ячейку на основании столбца А
        llastr = .Cells(.Rows.Count, 1).End(xlUp).Row
        'определяем последний столбец на основании столбца с метками
        llastc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'просмотр начинаем с 3-ей строки, т.к. именно с неё начинаются наши данные
        For lr = 3 To llastr
            'считываем фамилию с инициалами
            sWDDocName = .Cells(lr, 1).Value
            If sWDDocName <> "" Then
                'заменяем точки на пусто для удобочиатемости имен файлов
                sWDDocName = Replace(sWDDocName, ".", "")
                'составляем полный путь к создаваемому файлу,
                'при этом берем тоже расширение файла, что и шаблона
                sWDDocName = sToSavePath & sWDDocName & ".doc"
                'создаем новый документ Word на основании шаблона
                Set objWrdDoc = objWrdApp.Documents.Add(sWDTmplFullName)
                For lc = 1 To llastc
                    'запоминаем метку для поиска в файле Word
                    sFindVal = .Cells(1, lc).Value
                    'этим значением будем заменять текст метки
                    sReplaceVal = .Cells(lr, lc).Text
                    Set wdRange = objWrdDoc.Range
                    'заменяем метки {*} на текст из ячеек
                    wdRange.Find.ClearFormatting
                    wdRange.Find.Replacement.ClearFormatting
                    With wdRange.Find
                        .Text = sFindVal
                        .Replacement.Text = sReplaceVal
                        .Forward = True
                        .Wrap = 1 'wdFindContinue
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                    End With
                    wdRange.Find.Execute Replace:=2 'wdReplaceAll
                Next lc
                'сохраняем созданный документ, но не добавляем в список последних открытых
                objWrdDoc.SaveAs FileName:=sWDDocName, AddToRecentFiles:=False
                'закрываем документ Word
                objWrdDoc.Close False
            End If
        Next
    End With
    If IsNeedClose Then
        'закрываем приложение Word если открывали его кодом
        objWrdApp.Quit
    End If
    'очищаем переменные Word
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    '
    MsgBox "Файлы созданы и сохранены в папке '" & sToSavePath & "'", vbInformation, "www.excel-vba.ru"
End Sub
 
Вот примеры
 
Цитата
Deniska3 написал:
Как можно разбить текст в ячейки внесенный через ALT+ENTER, как у меня в примере
Данные -Текст по столбцам - с разделителями - символ-разделитель выбираем "другой" и жмем комбинацию клавиш "Ctrl+J". Затем готово!
Страницы: 1
Читают тему (гостей: 1)
Наверх