Возможно ли сделать так чтобы при копировании с 1листа один сталбец во 2 лист копировалось с добавлением одной пустой ячейки если между двух ячеек нет слова Отправил.(после точки постоянного слова отправил есть ещё несколько меняющихся слов) Фамилия Дата Отправил.(и разные слова после точки авто,поезд,автобус) Город
Фамилие Дата Город и т.д вот иногда нет слова Отправил.(и разный текст) между дата и город как во втором случае,существует ли формула,что бы добавить только пустую ячейку между дата и город ,а если есть слово Отправил то не чего не добавлять.
Возможно ли сделать так чтобы при копировании с 1листа один сталбец во 2 лист копировалось с добавлением одной пустой ячейки если между двух ячеек нет слова Отправил.(после точки постоянного слова отправил есть ещё несколько меняющихся слов) Фамилия Дата Отправил.(и разные слова после точки авто,поезд,автобус) Город
Фамилие Дата Город и т.д вот иногда нет слова Отправил.(и разный текст) между дата и город как во втором случае,существует ли формула,что бы добавить только пустую ячейку между дата и город ,а если есть слово Отправил то не чего не добавлять.Totalmen
Вроде бы все понятно, но все же лучше Ваш файл-пример посмотреть, а то вдруг внезапно, там окажутся интересные вещи, которых не видно в теле поста.
Вроде бы все понятно, но все же лучше Ваш файл-пример посмотреть, а то вдруг внезапно, там окажутся интересные вещи, которых не видно в теле поста.Nic70y
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) = "Город" And Cells(i - 1, 1) = "Дата" Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
[/vba] после вставки запустить макрос
такой вариант [vba]
Код
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) = "Город" And Cells(i - 1, 1) = "Дата" Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
Большое спасибо,я первый раз столкнулся с макросом я в шоке. А если такой вариант что между определённым словом (Отм.) и цифрами от 1до15 нет слова (Работа) нужно все 15 макросов писать ? файл прикрепил.
Большое спасибо,я первый раз столкнулся с макросом я в шоке. А если такой вариант что между определённым словом (Отм.) и цифрами от 1до15 нет слова (Работа) нужно все 15 макросов писать ? файл прикрепил.Totalmen
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) > 0 And InStr(Cells(i - 1, 1).Value, "Отм.") Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
[/vba]а может [vba]
Код
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) > 0 And Cells(i, 1) < 1000000 And InStr(Cells(i - 1, 1).Value, "Отм.") Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
[/vba]
[vba]
Код
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) > 0 And InStr(Cells(i - 1, 1).Value, "Отм.") Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
[/vba]а может [vba]
Код
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) > 0 And Cells(i, 1) < 1000000 And InStr(Cells(i - 1, 1).Value, "Отм.") Then Range("A" & i & ":B" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = 1 End Sub
Спасибо большое Nic70v вот ещё может кому поможет.
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) >= 1 And Cells(i, 1) <= 15 Then If Trim(Cells(i - 1, 1)) = "Отм." Then Range("A" & i & ":B" & i).Insert Shift:=xlDown End If Next i Application.ScreenUpdating = 1 End Sub
Спасибо большое Nic70v вот ещё может кому поможет.
Sub u_700() Application.ScreenUpdating = 0 u = Cells(Rows.Count, 1).End(xlUp).Row For i = u To 1 Step -1 If i = 1 Then Exit Sub If Cells(i, 1) >= 1 And Cells(i, 1) <= 15 Then If Trim(Cells(i - 1, 1)) = "Отм." Then Range("A" & i & ":B" & i).Insert Shift:=xlDown End If Next i Application.ScreenUpdating = 1 End SubTotalmen