Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 29.09.2010, 12:07   #1
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию Разделение строки на столбцы.

Имеем варианты строк размещенные в одной ячейке.

Aa Bb, Cc Dd, Ee Ff (Gg Hh (67'), Ss Vv, Xx 4, Tt 6,5, Mm Nn, Кк -), Ll 1), Pp 3, Rr Uu

Нужен результат:
Aa Bb
Cc Dd
Ee Ff
Gg Hh
Ss Vv
Xx
Tt
Mm Nn
Kk
Ll
Pp
Rr Uu

Разделитель как "," постоянен. Т.е. отсутствие в итоге любых цифр, и знаков.
Vasek007 вне форума Ответить с цитированием
Старый 29.09.2010, 13:41   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

вот такой функцией почти все получилось (вводится как формула массива)
Код:
Function Разделить(s As String)
  s0 = ""
  For i = 1 To Len(s)
    ch = Mid(s, i, 1)
    If (ch >= "a" And ch <= "z") Or (ch >= "A" And ch <= "Z") Or (ch >= "А" And ch <= "я") Or ch = " " Or ch = "," Then s0 = s0 & ch
  Next
  Разделить = WorksheetFunction.Transpose(Array(Split(s0, ",")))
End Function
что не получилось:
тупому компьютеру не обьяснишь, что после Ff должна была быть запятая, но ее не видно...
и что 6,5 - это число 6.5, а не разделение строки запятой на очередные порции
ну и с помощью Trim можно лидирующие пробелы убрать, но это Вам задание на дом
Вложения
Тип файла: rar Книга411.rar (11.9 Кб, 12 просмотров)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 29.09.2010, 14:02   #3
nilem
Форумчанин
 
Регистрация: 25.04.2010
Сообщений: 616
По умолчанию

Вариант. В А4 - строка, заполняем - начиная с С6. Ee Ff (Gg Hh (67') без запятой не разделяется.
Код:
Sub Разделить2()
Dim x, i As Integer, j As Integer, txt As String
x = Split([A4], ",", , 1)
For i = 0 To UBound(x)
    txt = ""
    For j = 1 To Len(x(i))
        If Mid(LCase(x(i)), j, 1) Like "*[a-z а-я]*" Then
            txt = txt & Mid(x(i), j, 1)
        End If
    Next j
    Cells(6 + i, 3) = Trim(txt)
Next i
End Sub
nilem вне форума Ответить с цитированием
Старый 29.09.2010, 14:03   #4
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию

Спасибо попробую, но я пошел другим путем

Код:
Sub d_1_RowToRow()
'Заменяем в тек.ячейке все не нужные нам символы на ","
ActiveCell.Replace What:="(", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:=")", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="'", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:=":", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="1", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="2", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="3", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="4", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="5", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="6", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="7", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="8", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="9", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="0", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:="–", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveCell.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

'Раскладываем строку на строки, где разделитель символ ","
x_y = ","
Dim sStr() As String, li As Long
Application.ScreenUpdating = False
sStr = Split(ActiveCell, x_y)
For li = 0 To UBound(sStr): ActiveCell.Offset(li + 1) = Trim(sStr(li)): Next li
Application.ScreenUpdating = True

End Sub
И подключил удаление пустых строк.

Код:
Sub b_DeleteEmptyRows()
'Удаление пустых строк в выделенном диапазоне
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = lastRow To 1 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

End Sub

Последний раз редактировалось Vasek007; 29.09.2010 в 14:08.
Vasek007 вне форума Ответить с цитированием
Старый 29.09.2010, 14:11   #5
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию

Цитата:
Сообщение от nilem Посмотреть сообщение
Вариант. В А4 - строка, заполняем - начиная с С6. Ee Ff (Gg Hh (67') без запятой не разделяется.
Код:
Sub Разделить2()
Dim x, i As Integer, j As Integer, txt As String
x = Split([A4], ",", , 1)
For i = 0 To UBound(x)
    txt = ""
    For j = 1 To Len(x(i))
        If Mid(LCase(x(i)), j, 1) Like "*[a-z а-я]*" Then
            txt = txt & Mid(x(i), j, 1)
        End If
    Next j
    Cells(6 + i, 3) = Trim(txt)
Next i
End Sub
Согласен проходит, только затык на
..., Ee Ff (Gg Hh (67'),...
Vasek007 вне форума Ответить с цитированием
Старый 29.09.2010, 14:18   #6
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
вот такой функцией почти все получилось (вводится как формула массива)[CODE]Function Разделить(s As String)
Тоже на конкретном примере работает но затык такой же
..., Ee Ff (Gg Hh (67'),...
Vasek007 вне форума Ответить с цитированием
Старый 29.09.2010, 14:21   #7
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию

Цитата:
Сообщение от nilem Посмотреть сообщение
Вариант. В А4 - строка, заполняем - начиная с С6. Ee Ff (Gg Hh (67') без запятой не разделяется.
Доработал
Код:
ActiveCell.Replace What:="(", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
И так же пошла.

Стоп затык на варианте
Aa Bb, Cc Dd, Ee Ff (Gg Hh (67'), Ss Vv, Xx 4, Tt 6,5, Mm Nn, Кк -), Ll 1), Pp 3, Rr Uu, Zz)

Последний раз редактировалось Vasek007; 29.09.2010 в 14:29.
Vasek007 вне форума Ответить с цитированием
Старый 29.09.2010, 21:58   #8
vikttur
Участник клуба
 
Регистрация: 16.05.2010
Сообщений: 1,249
По умолчанию

Меню Данные-Текст_по_столбцам-С_разделителями.
Далее столбцы транспонировать в строки.
vikttur вне форума Ответить с цитированием
Старый 04.10.2010, 20:17   #9
Vasek007
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 18
По умолчанию

Цитата:
Сообщение от vikttur Посмотреть сообщение
Меню Данные-Текст_по_столбцам-С_разделителями.
Далее столбцы транспонировать в строки.
И что дальше
Vasek007 вне форума Ответить с цитированием
Старый 05.10.2010, 01:37   #10
vikttur
Участник клуба
 
Регистрация: 16.05.2010
Сообщений: 1,249
По умолчанию

Вариант привел на случай, если не знали такой возможности.
Дальше разделители "," и "(", после этого удаление цифр "Найти/Заменить",
ручная чистка, как писали, "затыков" и транспонирование чистого диапазона.
vikttur вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разделение строки QuestionMark Microsoft Office Excel 2 22.06.2010 15:00
Разделение строки текста alex2read Microsoft Office Excel 10 18.05.2010 10:17
Разделение строки по критерию mephist Microsoft Office Excel 12 27.08.2009 11:07
Разделение строки xTANATOSx Общие вопросы Delphi 3 31.10.2007 21:27