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

Вход

Регистрация

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

 

= Мир MS Excel/Подстановки текста изходя из условия - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановки текста изходя из условия (Макросы/Sub)
Подстановки текста изходя из условия
Tatiana098 Дата: Суббота, 25.11.2017, 06:56 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Нужен макрос, для наглядности все описал на картинке
К сообщению приложен файл: 6028207.jpg(42Kb) · 6363828.xlsm(10Kb)


Сообщение отредактировал Tatiana098 - Суббота, 25.11.2017, 06:56
 
Ответить
СообщениеНужен макрос, для наглядности все описал на картинке

Автор - Tatiana098
Дата добавления - 25.11.2017 в 06:56
китин Дата: Суббота, 25.11.2017, 10:07 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4437
Репутация: 701 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
И вам здравствуйте!!!
как то так
[vba]
Код
Sub TTT()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
     If Range("A" & i) = 0 Then
        Rows(i).Delete
      Else
      Range("B" & i).Value = "Ремонт"
     End If
    Next
End Sub
[/vba]
[p.s.]объединенные ячейки зло для Экселя :'(
К сообщению приложен файл: Tatiana098.xlsm(18Kb)


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538


Сообщение отредактировал китин - Суббота, 25.11.2017, 11:22
 
Ответить
СообщениеИ вам здравствуйте!!!
как то так
[vba]
Код
Sub TTT()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
     If Range("A" & i) = 0 Then
        Rows(i).Delete
      Else
      Range("B" & i).Value = "Ремонт"
     End If
    Next
End Sub
[/vba]
[p.s.]объединенные ячейки зло для Экселя :'(

Автор - китин
Дата добавления - 25.11.2017 в 10:07
китин Дата: Суббота, 25.11.2017, 10:10 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4437
Репутация: 701 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
[offtop]хм, Tatiana098,
все описал

истелесно!!!


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщение[offtop]хм, Tatiana098,
все описал

истелесно!!!

Автор - китин
Дата добавления - 25.11.2017 в 10:10
Nic70y Дата: Суббота, 25.11.2017, 22:02 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4238
Репутация: 922 ±
Замечаний: 0% ±

Excel 2013
а так смешнее
[vba]
Код
Sub u_59()
    u = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:A" & u).Replace What:="0", Replacement:="", LookAt:=xlWhole
    Range("A2:A" & u).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    f = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B" & f & ":B" & u).Clear
    Range("B2" & ":B" & f).Merge
    With Range("B2" & ":B" & f)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Range("B2" & ":B" & f).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("B2" & ":B" & f).Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub
[/vba]


ЯД(poison) 41001841029809
+7 978 049 98 74 (мтс)
 
Ответить
Сообщениеа так смешнее
[vba]
Код
Sub u_59()
    u = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:A" & u).Replace What:="0", Replacement:="", LookAt:=xlWhole
    Range("A2:A" & u).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    f = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B" & f & ":B" & u).Clear
    Range("B2" & ":B" & f).Merge
    With Range("B2" & ":B" & f)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Range("B2" & ":B" & f).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("B2" & ":B" & f).Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 25.11.2017 в 22:02
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановки текста изходя из условия (Макросы/Sub)
Страница 1 из 11
Поиск:

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