Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выбрать телефонные номера из одной ячейки и вставить их в новые строки снизу
 
#1
31.08.2017 00:46:41
Где-то встречал макрос с яркой кнопкой, который делал то, что мне нужно, но найти никак не могу. Там в 10 столбце проверялась каждая ячейка, и если обнаруживалось несколько телефонных номеров, то добавлялось снизу этой строки ещё несколько строк, что бы расписать эти номера по отдельным строкам...

Что я могу сам: отфильтровать всю нужную информацию в одну строку с любыми разделительными знаками. Знаком с функциями с помощью которых можно отделить это всё.
Что у меня не получается: вставить 1 или 2 новых строки в зависимости от того, сколько номеров в ячейке.

В примере на "Лист1" желаемый результат.
Строк в файле очень много. У меня время-от-времени появляются такие файлы, их необходимо упорядочить. Помогите, пожалуйста.
Необходимый минимум: формулой при выполнении некоторого условия вставлять ниже определённое количество строк. Такой формулы не нашёл. Могу организовать столбец где будет выведено это количество.

Вот этот макрос добавляет. Как сделать, что бы ещё и вставлял второй номер из ячейки в строку ниже, третий номер из ячейки ещё ниже?
Код
Sub Duplicate_Rows()
    Dim cell As Range
 
    Set cell = Range("B2")      'первая ячейка в столбце с кол-вом билетов
    Do While Not IsEmpty(cell)
        If cell > 1 Then
            cell.Offset(1, 0).Resize(cell.Value - 1, 1).EntireRow.Insert    'вставляем N пустых строк
            cell.Resize(cell.Value, 1).EntireRow.FillDown                   'заполняем вниз из первых ячеек
        End If
        Set cell = cell.Offset(cell.Value, 0)
    Loop
End Sub
Изменено: kapandaiii - 31.08.2017 01:56:44 (Нашёл макрос)
 
 
 
#2
31.08.2017 11:00:33
Цитата
если обнаруживалось несколько телефонных номеров, то добавлялось снизу этой строки ещё несколько строк, что бы расписать эти номера по отдельным строкам...
И где у вас в примере несколько телефонных номеров в ячейке?
 
 
 
#3
31.08.2017 20:40:56
Цитата
Kuzmich написал:
И где у вас в примере несколько телефонных номеров в ячейке?
Там если дважды клацнуть по ячейке... они внутри ячеек. (не знаю, как это правильно называется)
 
 
 
#4
31.08.2017 21:25:59
Здравствуйте! Попробовал дважды клацать - все равно один №.
Очень понравилось:
Цитата
kapandaiii написал:
макрос с яркой кнопкой
:)  
 
 
 
#5
31.08.2017 21:29:06
_Igor_61,
Надо увеличить ширину строк
 
 
 
#6
31.08.2017 21:39:04
Не, у меня другое обнаружилось (ширина строк не при чем): перед номерами в строке формул виден апостроф, и если его стираешь, выскакивает текст, а потом после нажатия на ENTER снова в ячейке виден один номер. Я не знаю что это такое
 
 
 
#7
31.08.2017 21:50:05
_Igor_61 написал:
Здравствуйте! Попробовал дважды клацать - все равно один №.
То, что после символа 10 - смещено вниз и, если редактирование ячейки не раздвинуто на несколько строк - его не видно. В редактировании ячейки можно смещаться по строкам вниз стрелками или прокруткой.

А зачем Вам редактировать на месте? Выводите на другой лист. Так намного быстрее. Вставка строк медленно работает и чревата неудачей. Были у меня в практике невозможности вставки строк и столбцов из-за мусора на границе листов.

Например, так.
Код
Option Explicit

Sub Mnozh()
Dim cAlc As Variant
Dim strOk As Long, strMax As Long, strRes As Long, i As Long
Dim tmp As Variant

    cAlc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    strMax = Cells(Rows.Count, 2).End(xlUp).Row
    strRes = 0
    Sheets("Результат").UsedRange.ClearContents
    For strOk = 1 To strMax
        tmp = Split(Cells(strOk, 2), Chr(10))
        If UBound(tmp) < LBound(tmp) + 2 Then GoTo NXT
        For i = LBound(tmp) To UBound(tmp)
            If Len(Trim(tmp(i))) = 0 Then Exit For
            If 1 = 1 Then ' Сюда нужно вставить проверку на то, что в элементе номер телефона!
                strRes = strRes + 1
                Sheets("Результат").Cells(strRes, 1) = tmp(i)
                Sheets("Результат").Cells(strRes, 2) = tmp(UBound(tmp) - 1) & " " & _
                        tmp(UBound(tmp)) & " " & Cells(strOk, 1).Value & " " & Cells(strOk, 7).Value
            End If
        Next i
NXT:
    Next strOk
FIN:
    Application.Calculation = cAlc
    Application.ScreenUpdating = True
End Sub

Вот только я попытался предположить, что ИМЯ и 2017 и иже с ними - последние и предпоследние. Но оказалось, что не везде так. Нужно дорабатывать алгоритм после выявления закономерности их расположения в ячейках.
Ну, и негрешно вставить проверку: а номер ли телефона встречается в первых элементах после разбиения содержимого ячейки?
Изменено: PerfectVam - 31.08.2017 21:52:23
Следствие из третьего закона Чизхолма:
"Даже если ясность изложения исключает неверное толкование, все равно найдется кто-то, кто поймет Вас неправильно."
 
 
 
#8
31.08.2017 21:59:51
Да, я понял, что там символ 10, но что за апостроф в строке формул? И почему от него такой эффект?
 
 
 
#9
31.08.2017 22:08:00
Апостроф в начале значения показывает, что после него текст. В ячейке не отображается.
 
 
 
#10
31.08.2017 22:09:52
Теперь буду знать, спасибо!
 
 
 
#11
31.08.2017 22:25:02
Цитата
kapandaiii написал:
Там если дважды клацнуть по ячейке... они внутри ячеек.
- зачем клацать? Можно ведь смотреть в строке формул, там и править если что нужно.
http://prntscr.com/gfizg7
Или выделить диапазон строк и клацнуть один раз по границе любой строки - остальное сделает эксель:
http://prntscr.com/gfj15e
Изменено: Hugo - 31.08.2017 22:27:29
 
 
 
#12
31.08.2017 22:45:25
Нашёл я тот макрос с "яркой кнопкой")

Апостроф вставил для того, что бы номера телефонов начинающиеся на "+" не делали ячейку формулой (то-есть банально выскакивала ошибка).

Из исходной таблицы я буду перетаскивать столбцы в документ, в котором будут прописаны макросы-модули и формулы. Так я получу столбец №1 с ячейками, где будут один или несколько номеров в отформатированном виде с разделителем между ними " ". И получу столбец №2 с ячейками, где будут необходимые данные к этим номерам. Таким образом у меня будет 2 столбца с соблюдением соответствия НОМЕРА-ДАННЫЕ. Дальше я эти столбцы буду вкидывать в следующий файл, где лежит макрос "с яркой кнопкой :)" Там столбец №1 будет вставлен в столбец, где должны быть номера, а столбец №2 - в первый столбец из прикреплённого файла с макросом, т.к. я понял, что именно он является неким счётчиком... Планирую сделать так. Возможно, формулы-модули помещу в файл с макросом на отдельный лист.

Как переделать данный макрос (прикреплённый файл) что б номера вставлять не в 10 столбец, а в первый? (мне надо всего 2 столбца...)
 
 
 
#13
31.08.2017 23:29:06
Предложенный в посте 7 Вам подошел бы лучше. Но... хозяин-барин. В этом коде:
Код
    arr = ra.Resize(, 14).Value
    For i = LBound(arr) To UBound(arr)
        arr(i, 10) = Replace(Trim(arr(i, 10)), " ", ",")
    Next i
    arr = ExtendArray(arr, 10)

    Range("a2").Resize(UBound(arr, 1), 14).Value = arr
14 - общее число столбцов, которое будет в Вашей таблице
10 - тот самый десятый столбец. Меняете на номер нужного Вам столбца. Будьте внимательны: встречается в двух местах, как и 14.
В строке
Код
arr(i, 10) = Replace(Trim(arr(i, 10)), " ", ",")
разделитель пробел меняется на запятую. В Вашем случае вместо " " нужно Chr(10), а вместо запятой - то, что точно не встретится в Ваших данных!
Следствие из третьего закона Чизхолма:
"Даже если ясность изложения исключает неверное толкование, все равно найдется кто-то, кто поймет Вас неправильно."
 
 
 
#14
01.09.2017 03:50:25
PerfectVam, спасибо Вам огромное за Ваш профессионализм. Вроде как работает) Многое надо руками делать, но зато по несколько десятков тысяч строк сортирует само. Спасибо ещё раз. Всем спасибо :)

(решено)
 
 
 
Страницы: 1
Читают тему
Наверх