Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Замена html тэгов через VBA по всему диапазону столбца - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Замена html тэгов через VBA по всему диапазону столбца
БотаникЭкономики Дата: Четверг, 22.11.2018, 22:37 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый вечер. hands
в VBA ранее не работал, пришлось столкнуться.
История такая - спарсил данные с html тэгами, теперь их нужно привести в рабочий вид.

Перечитал весь рунет, ответам не нашел. Кто сможет помочь, буду благодарен :) Пример в приложении yes
К сообщению приложен файл: 3277517.xlsx (10.0 Kb)
 
Ответить
СообщениеДобрый вечер. hands
в VBA ранее не работал, пришлось столкнуться.
История такая - спарсил данные с html тэгами, теперь их нужно привести в рабочий вид.

Перечитал весь рунет, ответам не нашел. Кто сможет помочь, буду благодарен :) Пример в приложении yes

Автор - БотаникЭкономики
Дата добавления - 22.11.2018 в 22:37
БотаникЭкономики Дата: Четверг, 22.11.2018, 23:50 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вообщем разобрался почти сам.

Помогите написать макрос для функции ПЕЧСИМВ или CLEAN
Остальное понял как сделать
 
Ответить
СообщениеВообщем разобрался почти сам.

Помогите написать макрос для функции ПЕЧСИМВ или CLEAN
Остальное понял как сделать

Автор - БотаникЭкономики
Дата добавления - 22.11.2018 в 23:50
БотаникЭкономики Дата: Четверг, 22.11.2018, 23:56 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Решение найдено на зарубежном форуме.

Тэги заменил через запись макроса а сам ПЕЧСИМВ ниже.

[vba]
Код
Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 2005-09-29 join.htm
'-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
' - Optionally reenable improperly terminated Change Event macros
'
'Added CR and LF by VoG 3 June 2009
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Also Treat CHR 013, as a space (CHR 032)
Selection.Replace What:=Chr(13), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Also Treat CHR 010, as a space (CHR 032)
Selection.Replace What:=Chr(10), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]
 
Ответить
СообщениеРешение найдено на зарубежном форуме.

Тэги заменил через запись макроса а сам ПЕЧСИМВ ниже.

[vba]
Код
Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 2005-09-29 join.htm
'-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
' - Optionally reenable improperly terminated Change Event macros
'
'Added CR and LF by VoG 3 June 2009
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Also Treat CHR 013, as a space (CHR 032)
Selection.Replace What:=Chr(13), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Also Treat CHR 010, as a space (CHR 032)
Selection.Replace What:=Chr(10), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - БотаникЭкономики
Дата добавления - 22.11.2018 в 23:56
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!