Страницы: 1
RSS
Маленький макрос на преобразование текста
 
Ув. господа макросо- писатели , набросайте плиз макрос, который в выделенном диапазоне превратить текст типа :Польша / Polska- Шлепанцы / Klapek Синтетический материал / Materiał syntetyczny  в  Польша Шлепанцы Синтетический материал. Т.е. в каждом столбце найдет / и оставит текст до него , я конечно могу написать =ЛЕВСИМВ(D4;ПОИСК("/";D4;1)-1), но это долго.  
Спасибо
 
Public Sub www()  
   Dim c As Range  
   For Each c In ActiveSheet.UsedRange  
       If InStr(1, c.Value, "/") Then c.Value = Split(c.Value, "/")(0)  
   Next  
End Sub  
PS Сайт безбожно тормозит.
Я сам - дурнее всякого примера! ...
 
Sub MikkiAndShlepantsy()  
Dim LastRow As Long, i As Long, j As Integer  
LastRow = Cells(Rows.Count, 2).End(xlUp).Row  
   For i = 3 To LastRow  
       For j = 2 To 5  
           If Cells(i, j) Like "*/*" Then Cells(i, 6) = Cells(i, 6) & Split(Cells(i, j), "/")(0)  
       Next  
   Next  
End Sub
 
Спасибо всем  
KukLP  
If InStr(1, c.Value, "/") Then c.Value = Split(c.Value, "/")(0) тут ошибка у меня  
 
Юра минут 15 уже работает по 4000 строк...  
В конечном итоге исправил только одну строку в файле ..и убрал все ..в том числе то что не надо . Мне бы только в выделенном диапазоне. И скорости добавить у меня там формул в том числе летучих до ж....  
Спасибо
 
Миша, если по выделенному диапазону и нужно менять "на месте", то см. вариант Сержа. У меня, кстати, в его варианте никакой ошибки нет.  
Насчёт 15 минут на 4000 строк - сомнительно. Можно попробовать на массивах. Не знаю, что ты там "исправил", но скажи - ЗАЧЕМ? И данные лучше бы показывать со своими формулами...
 
Про выделенный диапазон написал в первом посте.  
Знаешь Юра я о -первых не ничего не правил и не вру у меня в Варианте Сергея ошибка на примере работает на реальных данных нет пишет Тайп мистматч  
Файлик у меня огромный смысла нет его весь выкладывать
 
Миш, про исправление извини: вот эту строку "В конечном итоге исправил только одну строку в файле" я прочитал невнимательно - подумал, что ТЫ исправил строку в макросе :-)    
Насчёт ошибки - у меня действительно макрос Сержа не ругается.  
Насчёт большого файла - обрезать никак? :-) Ведь я и Серж делали по твоему образцу. И уточни - тебе менять на месте или, как у меня?
 
Да друзья, я когда увидел вариант Юры - сильно засомневался, что правильно понял задачу. В топике "Польша Шлепанцы Синтетический материал" одним значением(строкой). Юра именно такое решение предложил. Поэтому в силе вопрос Юры: "Ведь я и Серж делали по твоему образцу. И уточни - тебе менять на месте или, как у меня?". Миш, в зависимости от ответа на этот вопрос, я не против(если менять на месте), чтоб ты кинул мне файл в личку. Посмотрю, поправлю, что надо. В принципе я сразу хотел предложить тебе - если данных много - можно радикально ускорить за счет evaluate. Юрин вариант тоже можно поколдовать, но там Юре карты в руки:-)Боюсь, что все-таки он правильней угадал.
Я сам - дурнее всякого примера! ...
 
Нет Сереж правильно угадал ты ..менять надо на месте ..в приложенном файле четко видно, что все эти Польши и шлепанцы в разных столбцах .. причем по нему твой макрос нормально работает . А на большом не хочет Хотя я маленький делал копированием куска большого. Почему там макрос не пашет -загадка.Я отправлю большой мне не жалко ... и буду рад помощи спасибо .
 
{quote}{login=Микки}{date=31.05.2012 10:22}{thema=Маленький макрос на преобразование текста}{post}... Т.е. в каждом столбце найдет / и оставит текст до него, я конечно могу...{/post}{/quote}  
Недолга - см. скрин... Как вариант... ;) -87673-
 
{quote}{login=Z}{date=31.05.2012 06:22}{thema=Re: Маленький макрос на преобразование текста}{post}{quote}{login=Микки}{date=31.05.2012 10:22}{thema=Маленький макрос на преобразование текста}{post}... Т.е. в каждом столбце найдет / и оставит текст до него, я конечно могу...{/post}{/quote}  
Недолга - см. скрин... Как вариант... ;) -87673-{/post}{/quote}  
Нет у меня в файле есть и очень нужный текст после / не пойдет ..хотя мысль классная
 
Да, код спотыкался на первой же формуле, вернувшей ошибку. Получалась генерация ошибок за счет формулы Михаила, возвращающей ошибку: =ЛЕВСИМВ(F4;ПОИСК("/";F4;1)-2), поскольку символ "/" кодом убирался:-) Просто исключил обработку формул в коде.  
Public Sub www()  
   Dim c As Range, t!  
   t = Timer  
   For Each c In ActiveSheet.UsedRange  
   If Not c.HasFormula Then _  
       If InStr(1, c.Value, "/") Then c.Value = Split(c.Value, "/")(0)  
   Next  
   MsgBox Timer - t  
End Sub  
Миша, понятно, что эта формула более не актуальна, меняй.:-)
Я сам - дурнее всякого примера! ...
 
{quote}{login=Микки}{date=31.05.2012 06:28}{thema=Re: Re: Маленький макрос на преобразование текста}{post}Нет у меня в файле есть и очень нужный текст после / не пойдет ..хотя мысль классная{/post}{/quote}  
Михаил, так примени данный метод только к выделенным ячейкам, а не ко всему листу
 
{quote}{login=Микки}{date=31.05.2012 06:03}{thema=}{post}Нет Сереж правильно угадал ты ..{/post}{/quote}Миш, вот чтобы избежать этих угадываний - старайся в следующий формулировать задачу более чётко :-) А то видишь, какие разночтения?
 
Ю-функция. На 60000 подтормаживает, а на 30000 - вроде ничего:
 
Спасибо всем тему можно закрывать. Сергей прислал рабочий Вариант ..главное понятно в чем была ошибка. Саша сорь это совсем не то, мне надо на месте убирать / в некоторых столбцах.
Страницы: 1
Наверх