Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Помогите пожалуйста написать макрос СЖПРОБЕЛЫ !
 
#1
09.08.2010 14:46:04
Добрый день товарищи. Работаю с большими таблицами данных. Чтобы Excel правильно понимал их, периодически нужно бывает сжимать пробелы в текстовых ячейках. Каждый раз для этого делаю дополнительнвй столбец, затем сжимаю там пробелы и только потом со специальной вставкой ставлю значения в исходную ячейку.Помогите пожалуйста написать макрос СЖПРОБЕЛЫ, чтобы при выделении групп ячеек и запускании макроса, он автоматически сжимал бы пробелы в этих ячейках.  
 
Спасибо заранее  
С уважением Самир, Баку !
 
 
 
#2
09.08.2010 14:54:28
Макрорекордером записать "Найти: и Заменить на:".
 
 
 
#3
09.08.2010 14:57:03
{quote}{login=}{date=09.08.2010 02:54}{thema=}{post}Макрорекордером записать "Найти: и Заменить на:".{/post}{/quote}  
 
Думаю что это мне не подойдет. Я заранее не знаю что мне надо найти и на что заменить. Мне надо выделить группу или диапазон ячеек, нажать кнопку макроса и сжать пробелы в этих ячейках.  
 
Самир
 
 
 
#4
09.08.2010 15:00:55
Попробуйте  
Sub Samir()  
Dim poz As Range  
For Each poz In Selection.Cells  
'poz.Value = LTrim$(poz) 'удалить пробелы слева  
'poz.Value = RTrim$(poz) 'удалить пробелы справа  
poz.Value = Trim$(poz) 'удалить пробелы с обеих сторон  
Next poz  
End Sub
 
 
 
#5
09.08.2010 15:21:01
Все работает! Супер!  
 
nilem, спасибо!  
 
The Prist - спасибо большое! вы меня уже в n-ый раз выручаете!  
 
С уважением - Самир, Баку
 
 
 
#6
09.08.2010 16:13:29
Чуть по-другому, но зато не искалечит константы в формулах и обработает только видимые под фильтром строки (у которых высота >0)  
Sub Trim_By_Formula()   ' применить функцию СЖПРОБЕЛЫ к ячейкам выделенного диапазона  
  Dim iCell As Range, rRange As Range  
  Set rRange = Intersect(Selection, ActiveSheet.UsedRange)  
  Application.ScreenUpdating = False  
  For Each iCell In rRange  
     With iCell  
        If .EntireRow.Height > 0 _  
           And Not (.HasFormula) _  
           And Not IsDate(.Value) _  
           And Not .NumberFormat Like "*" & ":" & "*" Then   'если строка не скрыта и в ячейке не формула, не дата, не время  
           .Value = Application.WorksheetFunction.Trim(.Value)  
        End If  
     End With  
  Next  
 
  'Вместо цикла можно сделать и так, как предлагал The_Prist, но тогда не удастся проверять формат ячеек:  
  'rRange.Value = Application.Trim(rRange.Value)  
 
  Application.ScreenUpdating = True  
  rRange.Select  
End Sub
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
 
 
#7
09.08.2010 16:47:48
{quote}{login=Alex_ST}{date=09.08.2010 04:13}{thema=}{post}Чуть по-другому, но зато не искалечит константы в формулах и обработает только видимые под фильтром строки (у которых высота >0)  
Sub Trim_By_Formula()   ' применить функцию СЖПРОБЕЛЫ к ячейкам выделенного диапазона  
  Dim iCell As Range, rRange As Range  
  Set rRange = Intersect(Selection, ActiveSheet.UsedRange)  
  Application.ScreenUpdating = False  
  For Each iCell In rRange  
     With iCell  
        If .EntireRow.Height > 0 _  
           And Not (.HasFormula) _  
           And Not IsDate(.Value) _  
           And Not .NumberFormat Like "*" & ":" & "*" Then   'если строка не скрыта и в ячейке не формула, не дата, не время  
           .Value = Application.WorksheetFunction.Trim(.Value)  
        End If  
     End With  
  Next  
 
  'Вместо цикла можно сделать и так, как предлагал The_Prist, но тогда не удастся проверять формат ячеек:  
  'rRange.Value = Application.Trim(rRange.Value)  
 
  Application.ScreenUpdating = True  
  rRange.Select  
End Sub{/post}{/quote}  
 
Спасибо Алекс большое. Переписал твою формулу. Сейчас она у меня в копилке бестселлеровских!  
 
С уважением - Самир, Баку
 
 
 
Страницы: 1
Читают тему
Наверх