Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разобрать строку в массив на буквы и цифры - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разобрать строку в массив на буквы и цифры (Макросы/Sub)
Разобрать строку в массив на буквы и цифры
Elhust Дата: Четверг, 09.08.2018, 09:39 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток уважаемые специалисты и просто гуру excel , возникла трудность которую никак не удаётся победить
Есть строка длинной в 32 тыс. знаков , выглядит это так (1111121321312вапвапвапвап654651318ываываываыва646516516541ываываываыва654651651651)
Нужно сделать массив в котором первый столбец это 1111121321312,654651318,646516516541,654651651651 а второй это буквы
начал делать но что то подсказывает мне что я не на том пути ....
[vba]
Код

Sub perebor()
Dim S As String
Dim i, n, k As long
  
S = Range("B12").Value
n = Len(S)

For i = 1 To n
ch = Mid(S, i, 1)

'MsgBox Not IsNumeric(ch)
If Not IsNumeric(ch) Then

End If
Next i
End Sub
[/vba]


Каждый сам выбирает правила игры
 
Ответить
СообщениеДоброго времени суток уважаемые специалисты и просто гуру excel , возникла трудность которую никак не удаётся победить
Есть строка длинной в 32 тыс. знаков , выглядит это так (1111121321312вапвапвапвап654651318ываываываыва646516516541ываываываыва654651651651)
Нужно сделать массив в котором первый столбец это 1111121321312,654651318,646516516541,654651651651 а второй это буквы
начал делать но что то подсказывает мне что я не на том пути ....
[vba]
Код

Sub perebor()
Dim S As String
Dim i, n, k As long
  
S = Range("B12").Value
n = Len(S)

For i = 1 To n
ch = Mid(S, i, 1)

'MsgBox Not IsNumeric(ch)
If Not IsNumeric(ch) Then

End If
Next i
End Sub
[/vba]

Автор - Elhust
Дата добавления - 09.08.2018 в 09:39
sboy Дата: Четверг, 09.08.2018, 10:14 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2112
Репутация: 605 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
[vba]
Код
Sub mas_()
Dim arr
    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+)(\D+)"
        .Global = True
        With .Execute([e9].Value)
            ReDim arr(0 To .Count - 1, 0 To 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        End With
    End With
    Range(Cells(1), Cells(UBound(arr), 2)).Value = arr
End Sub
[/vba]
К сообщению приложен файл: 4763350.xlsm(15.7 Kb)
 
Ответить
СообщениеДобрый день.
[vba]
Код
Sub mas_()
Dim arr
    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+)(\D+)"
        .Global = True
        With .Execute([e9].Value)
            ReDim arr(0 To .Count - 1, 0 To 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        End With
    End With
    Range(Cells(1), Cells(UBound(arr), 2)).Value = arr
End Sub
[/vba]

Автор - sboy
Дата добавления - 09.08.2018 в 10:14
Elhust Дата: Четверг, 09.08.2018, 11:13 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, Большущее спасибо !!!!!!!!! сейчас буду изучать это очень интересно ) спасибо ещё раз :)


Каждый сам выбирает правила игры
 
Ответить
Сообщениеsboy, Большущее спасибо !!!!!!!!! сейчас буду изучать это очень интересно ) спасибо ещё раз :)

Автор - Elhust
Дата добавления - 09.08.2018 в 11:13
Elhust Дата: Четверг, 09.08.2018, 16:56 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, Прошу прощения ... а как сделать если таких ячейки две или больше ?


Каждый сам выбирает правила игры
 
Ответить
Сообщениеsboy, Прошу прощения ... а как сделать если таких ячейки две или больше ?

Автор - Elhust
Дата добавления - 09.08.2018 в 16:56
sboy Дата: Четверг, 09.08.2018, 17:07 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2112
Репутация: 605 ±
Замечаний: 0% ±

Excel 2010
делать по ним цикл и:
1вариант выгружать массивы по одному, друг под другом
2вариант увеличивать массив в цикле ReDim Preserve
 
Ответить
Сообщениеделать по ним цикл и:
1вариант выгружать массивы по одному, друг под другом
2вариант увеличивать массив в цикле ReDim Preserve

Автор - sboy
Дата добавления - 09.08.2018 в 17:07
Elhust Дата: Пятница, 10.08.2018, 10:38 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, ещё не проверил и зачем то скидываю ..
[vba]
Код

    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+)(\D+)"
        .Global = True
        For a = 1 To UBound(la)
        MsgBox la(a)
        With .Execute(la(a).Value)
        If reg = 0 Then
            ReDim arr(0 To .Count - 1, 0 To 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        Else
            ReDim Preserve arr(UBound(Arring) + 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        End If
            reg = reg + 1
        End With
        Next a
    End With
[/vba]


Каждый сам выбирает правила игры
 
Ответить
Сообщениеsboy, ещё не проверил и зачем то скидываю ..
[vba]
Код

    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+)(\D+)"
        .Global = True
        For a = 1 To UBound(la)
        MsgBox la(a)
        With .Execute(la(a).Value)
        If reg = 0 Then
            ReDim arr(0 To .Count - 1, 0 To 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        Else
            ReDim Preserve arr(UBound(Arring) + 1)
                For i = 0 To .Count - 1
                    arr(i, 0) = .Item(i).submatches(0)
                    arr(i, 1) = .Item(i).submatches(1)
                Next
        End If
            reg = reg + 1
        End With
        Next a
    End With
[/vba]

Автор - Elhust
Дата добавления - 10.08.2018 в 10:38
Elhust Дата: Пятница, 10.08.2018, 12:04 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, проверил с одномерным массивом с двумерным с циклом по элементам и везде одна и та же ошибка
обджект рекваэред
[vba]
Код
With .Execute(la(a).Value)
[/vba]
я вот не понимаю почему ячейки он принимает а массивы нет ....


Каждый сам выбирает правила игры
 
Ответить
Сообщениеsboy, проверил с одномерным массивом с двумерным с циклом по элементам и везде одна и та же ошибка
обджект рекваэред
[vba]
Код
With .Execute(la(a).Value)
[/vba]
я вот не понимаю почему ячейки он принимает а массивы нет ....

Автор - Elhust
Дата добавления - 10.08.2018 в 12:04
Elhust Дата: Пятница, 10.08.2018, 13:03 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, ахаха такой бред пишу создаётся двумерный а я изменяю одномерный нефига я умник ахах )


Каждый сам выбирает правила игры
 
Ответить
Сообщениеsboy, ахаха такой бред пишу создаётся двумерный а я изменяю одномерный нефига я умник ахах )

Автор - Elhust
Дата добавления - 10.08.2018 в 13:03
sboy Дата: Пятница, 10.08.2018, 13:29 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 2112
Репутация: 605 ±
Замечаний: 0% ±

Excel 2010
Вы прикладывайте полный код (лучше в файлике).
Из того куска, что приложили непонятно, что такое la и Arring
 
Ответить
СообщениеВы прикладывайте полный код (лучше в файлике).
Из того куска, что приложили непонятно, что такое la и Arring

Автор - sboy
Дата добавления - 10.08.2018 в 13:29
Elhust Дата: Пятница, 10.08.2018, 13:32 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy, согласен , вот
я там то что выше выложил поторапился косяков много ...
К сообщению приложен файл: 3099890.xlsm(66.0 Kb)


Каждый сам выбирает правила игры

Сообщение отредактировал Elhust - Пятница, 10.08.2018, 13:37
 
Ответить
Сообщениеsboy, согласен , вот
я там то что выше выложил поторапился косяков много ...

Автор - Elhust
Дата добавления - 10.08.2018 в 13:32
sboy Дата: Пятница, 10.08.2018, 15:07 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 2112
Репутация: 605 ±
Замечаний: 0% ±

Excel 2010
То, что Вы приложили в файле совсем отличается от
Есть строка длинной в 32 тыс. знаков

тут достаточно небольшой UDF
[vba]
Код
Function Elhust(t As String, p As String)
    With CreateObject("VBScript.RegExp")
        .Pattern = p
        Elhust = .Execute(t)(0)
    End With
End Function
[/vba]
данные урезал, чтоб файл влез на форум
К сообщению приложен файл: 3099890.xlsb(97.0 Kb)
 
Ответить
СообщениеТо, что Вы приложили в файле совсем отличается от
Есть строка длинной в 32 тыс. знаков

тут достаточно небольшой UDF
[vba]
Код
Function Elhust(t As String, p As String)
    With CreateObject("VBScript.RegExp")
        .Pattern = p
        Elhust = .Execute(t)(0)
    End With
End Function
[/vba]
данные урезал, чтоб файл влез на форум

Автор - sboy
Дата добавления - 10.08.2018 в 15:07
Elhust Дата: Пятница, 10.08.2018, 15:47 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 178
Репутация: -1 ±
Замечаний: 0% ±

Excel 2010
sboy,а из массива их никак не разобрать ?(( я чёт уже три дня туплю


Каждый сам выбирает правила игры

Сообщение отредактировал Elhust - Пятница, 10.08.2018, 15:47
 
Ответить
Сообщениеsboy,а из массива их никак не разобрать ?(( я чёт уже три дня туплю

Автор - Elhust
Дата добавления - 10.08.2018 в 15:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разобрать строку в массив на буквы и цифры (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!