Разделение ячейки по переносу строки VBA

Пользователь

Сообщений: 115 Регистрация: 14.11.2016

12.01.2020 00:56:52

Есть файл который помогал вытянуть часть текста из ячейки на основании разделителя Alt+Enter (файл прикладываю). Но почему, то он перестал работать. Попробовал написать пользовательскую функцию для этого (но поскольку мои знания VBA ограничиваются записью макрорекордером), то и данная функция не работает. Помогите пожалуйста вернуть работоспособность файлу или поправить функцию. Спасибо.

Код
Function KS_line(n As Range, i As Integer) Dim masiv() masiv = Split(n, Chr(10)) KS_line = masiv(i) End Function

Прикрепленные файлы

KS_LINE.xla (17 КБ)

Изменено: Dante132 - 12.01.2020 00:58:06

ocet p

Пользователь

Сообщений: 448 Регистрация: 24.03.2018

12.01.2020 03:16:04

Dim masiv() ==> Dim masiv

Например:

Код

Option Explicit

Sub Call_KS_line() '... :)
    Dim i%, mmnt
    With ActiveSheet
        mmnt = ChrW(1025) & Chr(10)
        For i = 1040 To 1103
            mmnt = mmnt & ChrW(i) & Chr(10)
        Next
        mmnt = mmnt & ChrW(1105)
        [A1].Value = mmnt
        With .Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 50, 40, 40)
            .Name = "Cube_AzHuRwPozA_1"
            With .TextFrame.Characters
                .Font.Size = 30: .Font.Bold = True
                For i = 0 To UBound(Split([A1].Value, Chr(10), -1, 1))
                    .Text = KS_line([A1], i) '<<<================================== ... :)
                    mmnt = Timer: While Timer - mmnt < 0.3: DoEvents: Wend
                Next
                .Text = ""
            End With
        End With
        .Shapes("Cube_AzHuRwPozA_1").Delete
        [A1].Clear
    End With
End Sub

Function KS_line(n As Range, Optional i% = 0)
    Dim masiv
    masiv = Split(n.MergeArea.Cells(1, 1).Value, Chr(10), -1, 1)(i)
    'masiv = Split(n.Cells(1, 1).Value, Chr(10), -1, 1)(i)
    KS_line = masiv
End Function