Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
создание макроса для форматирования текста
 
#1
09.08.2009 02:29:56
Здравствуйте!  
С помощью Уважаемых посетителей этого форума мне удалось сделать макрос, считывающий информацию из интернета, за что огромное Вам всем спасибо!  
Не поможете мне с продолжением моей работы? Вопросов сразу несколько. Сейчас передо мной стоит следующая задача - отформатировать и рассортировать полученный большой массив информации из нескольких тысяч строк по заданным критериям. Полученная информация выглядит примерно следующим образом, построчно:  
 
1-2-3-4 |  Андрей  |  Борис  | Владимир | ... |  
4-5-6-7 | Геннадий | Дмитрий | Евгений  | ... |  
1-2-3-4 |  Павел   |  Роман  |  Сергей  | ... |  
 
Образец таблицы я приложил в файле и воспроизвожу его в этой теме только для того, чтобы легче было сформулировать свои вопросы, которых у меня несколько.  
1. В каждой ячейке первого столбца мне нужно удалить первые два символа, в данном случае это "1-", "4-", "1-".  
2. Второй столбец удаляется, а на его место переносятся первые буквы слов из третьего и четвертого столбцов, разделенные пробелом. После чего 3-й и 4-й столбцы удаляются. То есть вот так:  
 
2-3-4 |  Б В  | ... |  
5-6-7 |  Д Е  | ... |  
2-3-4 |  Р С  | ... |  
 
3. Полученные записи построчно копируются в листы, поименованные по значению первой ячейки строки. То есть Лист("2-3-4") и Лист("5-6-7").  
4. Если можно, подскажите мне, как вывести на экран запуск этого макроса с помощью MsgBox.
 
 
 
#2
09.08.2009 02:42:22
1. В Вашем примере ячейки А1 и А3 одинаковые, а двух листов с одинаковыми именами в Книге иметь не получится;  
2. Зачем MsgBox?
 
 
 
#3
09.08.2009 02:46:54
Попробуйте такой вариант:  
 
http://excelvba.ru/XL_Files/Sample__09-08-2009__4-46-31.zip  
 
 
Вот весь макрос:  
 
Sub test()  
   If MsgBox("Обработать данные?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub  
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
   Columns(2).Delete:    ' On Error Resume Next  
   For Each cell In ra.Cells  
       cell = Mid(cell, 3)    ' оставляем только часть текста, начиная с 3-го символа  
       cell.Next = Left(cell.Next, 1) & " " & Left(cell.Next.Next, 1)    ' первые буквы  
       cell.Next.Next.Delete xlShiftToLeft  
       cell.Next.Resize(, Columns.Count - 1).Copy _  
               Worksheets(cell.Text).Range("a" & Rows.Count).End(xlUp).Offset(1)  
   Next cell  
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#4
09.08.2009 02:49:58
1. Видите ли, я специально указал ячейки А1 и А3 одинаковыми. Поэтому строки 1 и 3, после форматирования, мне нужно скопировать на один и тот же лист с названием "2-3-4". В столбце А несколько тысяч строк, а значений его ячеек всего десяток, поэтому ячейки обязательно будут повторяться в исходной таблице.  
2. Я планирую создать для удобства работы еще несколько кнопок для запуска других макросов на первом листе и просто хотел понять, как это сделать.
 
 
 
#5
09.08.2009 02:54:02
EducatedFool, спасибо, Ваш образец делает почти все, что мне нужно. Единственное - можно ли скопировать все данные построчно на отдельные листы с названием первых ячеек строк?
 
 
 
#6
09.08.2009 02:56:38
По первому вопросу понятно. Тестируйте вариант от EducatedFool (зря он себе такой ник придумал :-))  
По второму. Можно создать одну UserForm, а на ней несколько кнопок для запуска различных макросов. MsgBox на мой взгляд не нужен.
 
 
 
#7
09.08.2009 03:06:48
{quote}{login=Brox}{date=09.08.2009 02:54}{thema=Re: }{post}Единственное - можно ли скопировать все данные построчно на отдельные листы с названием первых ячеек строк?{/post}{/quote}  
 
А что, мой макрос разве этого не делает???????
 
 
 
#8
09.08.2009 03:10:58
А вот Вам Форма с кнопками под разные макросы.
 
 
 
#9
09.08.2009 03:13:12
{quote}{login=}{date=09.08.2009 03:06}{thema=Re: Re: }  
А что, мой макрос разве этого не делает???????{/post}{/quote}  
Прошу прощения, не обратил внимания в образце. Действительно делает.    
А как задать команду, чтобы при появлении нового значения в ячейке "А" новый лист с таким же названием создавался автоматически?
 
 
 
#10
09.08.2009 03:14:16
{quote}{login=}{date=09.08.2009 03:06}{thema=Re: Re: }{post}{quote}{login=Brox}{date=09.08.2009 02:54}{thema=Re: }{post}Единственное - можно ли скопировать все данные построчно на отдельные листы с названием первых ячеек строк?{/post}{/quote}  
А что, мой макрос разве этого не делает???????{/post}{/quote}  
Я так понимаю, что изначально всего один лист, а затем листы добавляются по мере необходимости.
 
 
 
#11
09.08.2009 03:24:51
Тогда так:  
 
Sub test()  
   If MsgBox("Обработать данные?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub  
     
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = Range([A1], Range("A" & Rows.Count).End(xlUp))
   Columns(2).Delete: On Error Resume Next  
   For Each cell In ra.Cells  
       cell = Mid(cell, 3)    ' оставляем только часть текста, начиная с 3-го символа  
       cell.Next = Left(cell.Next, 1) & " " & Left(cell.Next.Next, 1)    ' первые буквы  
       cell.Next.Next.Delete xlShiftToLeft  
 
       Err.Clear: x = Worksheets(cell.Text).Name  
       If Err.Number Then Worksheets.Add.Name = cell.Text  
 
       cell.Next.Resize(, Columns.Count - 1).Copy _  
               Worksheets(cell.Text).Range("a" & Rows.Count).End(xlUp).Offset(1)  
   Next cell  
End Sub  
 
> Я так понимаю, что изначально всего один лист, а затем листы добавляются по мере необходимости.  
Я тоже это понимаю. И подумал об этом изначально.  
Но раз в задании не было ничего сказано про создание новых листов, я и не стал делать.
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#12
09.08.2009 03:28:34
{quote}{login=Юрий М}{date=09.08.2009 03:14}{thema=Re: Re: Re: }Я так понимаю, что изначально всего один лист, а затем листы добавляются по мере необходимости.{/post}{/quote}  
Да, но что произойдет, если среди нескольких тысяч строк, которые будут дополняться новыми строками с данными, я найду 10 значений ячейки А, создам 10 листов, а потом появится ячейка с новым значением, одиннадцатым, для которой лист не создан?  
Я так понимаю, макрос покажет сбой.
 
 
 
#13
09.08.2009 03:34:11
EducatedFool, Юрий М, спасибо большое!
 
 
 
#14
12.08.2009 00:37:51
Так получилось, что мне понадобилось использовать часть кода, данного Вами в этом посте:  
 
Sub test()  
   Dim cell As Range  
   For Each cell In Range([A2], Range("A" & Rows.Count).End(xlUp))
       Err.Clear: x = Worksheets(cell.Text).Name  
       If Err.Number Then Worksheets.Add.Name = cell.Text  
       cell.Next.Resize(, Columns.Count - 1).Copy _ Worksheets(cell.Text).Range("a" & Rows.Count).End(xlUp).Offset(1)  
   Next cell  
End Sub  
 
Но почему-то отдельно этот код не работает. Не можете посказать, в чем тут дело?
 
 
 
#15
12.08.2009 01:04:49
Прошу прощения, случайно поставил треугольник закрытия темы.
 
 
 
#16
12.08.2009 05:19:25
Будьте внимательнее при удалении "лишних" строк.  
Не все из них такие уж и лишние...  
 
 
Sub test()  
   Application.ScreenUpdating = False    ' отключаем обновление экрана  
   On Error Resume Next    ' отключаем вывод ошибок  
     
   Dim cell As Range  
   For Each cell In Range([A2], Range("A" & Rows.Count).End(xlUp))
       Err.Clear: x = Worksheets(cell.Text).Name  
       If Err.Number Then Worksheets.Add.Name = cell.Text  
       cell.Next.Resize(, Columns.Count - 1).Copy Worksheets(cell.Text).Range("a" & Rows.Count).End(xlUp).Offset(1)  
   Next cell  
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#17
12.08.2009 11:26:25
Спасибо, макрос заработал!  
Но еще вопрос. После выполнения этого макроса мне нужно поменять местами 5 столбцов. Я сделал для этого вот такой макрос:  
Sub test1()  
   Columns("A:E").Select  
   Selection.Cut  
   Columns("K:O").Select  
   ActiveSheet.Paste  
   Columns("A:E").Select  
   Selection.Delete xlShiftToLeft  
End Sub  
Оба макроса по отдельности работают, но как только я их сливаю в один код, происходит сбой. Что им мешает работать вместе?
 
 
 
#18
12.08.2009 13:16:07
{quote}{login=}{date=12.08.2009 11:26}{thema=}{post}Спасибо, макрос заработал!  
Но еще вопрос. После выполнения этого макроса мне нужно поменять местами 5 столбцов. Я сделал для этого вот такой макрос:  
Sub test1()  
   Columns("A:E").Select  
   Selection.Cut  
   Columns("K:O").Select  
   ActiveSheet.Paste  
   Columns("A:E").Select  
   Selection.Delete xlShiftToLeft  
End Sub  
Оба макроса по отдельности работают, но как только я их сливаю в один код, происходит сбой. Что им мешает работать вместе?{/post}{/quote}  
Вы уж подготовьте сразу все вопросы.
 
 
 
Страницы: 1
Читают тему
Наверх