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

Вход

Регистрация

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

 

= Мир MS Excel/макрос для копирования строки при условии - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос для копирования строки при условии (Макросы/Sub)
макрос для копирования строки при условии
Konkruk Дата: Понедельник, 30.12.2019, 11:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2010
Привет всем, помогите изменить макрос, чтобы строки копировались с первого листа на второй только не при условии что 4-й столбец в 1листе = Россия, а при условии что в 4-м столбце 1-го листа содержится часть слова или часть текста равная "Рос" (на 6-м листе добавил столбцы чтобы было понятно для чего нужно именно так. На список городов не обращайте внимания - там в разнобой все). насколько я понимаю - нужно изменить эту строку:
If Mid(Cells(i, 4), 1, 6) = "Россия" Then в макросе:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
        If Mid(Cells(i, 4), 1, 6) = "Россия" Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("Лист2").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]

И если можно пояснить вообще эту строку, что значат в ней цифры и i
К сообщению приложен файл: 7900992.xlsm (20.9 Kb)


Сообщение отредактировал Konkruk - Понедельник, 30.12.2019, 11:16
 
Ответить
СообщениеПривет всем, помогите изменить макрос, чтобы строки копировались с первого листа на второй только не при условии что 4-й столбец в 1листе = Россия, а при условии что в 4-м столбце 1-го листа содержится часть слова или часть текста равная "Рос" (на 6-м листе добавил столбцы чтобы было понятно для чего нужно именно так. На список городов не обращайте внимания - там в разнобой все). насколько я понимаю - нужно изменить эту строку:
If Mid(Cells(i, 4), 1, 6) = "Россия" Then в макросе:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
        If Mid(Cells(i, 4), 1, 6) = "Россия" Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("Лист2").Range("A" & LastRow + 1)
        End If
     End If
End Sub
[/vba]

И если можно пояснить вообще эту строку, что значат в ней цифры и i
Автор - Konkruk
Дата добавления - 30.12.2019 в 11:01
Nic70y Дата: Понедельник, 30.12.2019, 11:17 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
ка-то так
[vba]
Код
        If InStr(Cells(i, 4), "Рос") > 0 Then
[/vba]наверное

ЮMoney 41001841029809
 
Ответить
Сообщениека-то так
[vba]
Код
        If InStr(Cells(i, 4), "Рос") > 0 Then
[/vba]наверное
Автор - Nic70y
Дата добавления - 30.12.2019 в 11:17
Konkruk Дата: Понедельник, 30.12.2019, 11:51 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2010
Nic70y,
Да все работает, спасибо большое.
Подскажите, если не сложно, еще вопрос, если в этот макрос добавить еще строку для вставки даты в 11 столбец при заполнении 10 (в оригинале просто столбцов больше), правильно ли будет просто скопировать строку и поменять на 10 значение "2": и надо ли добавлять end if еще?
вот так получается:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 10 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "Рос") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("Лист2").Range("A" & LastRow + 1)
        End If
     End If
End Sub
   
[/vba]


Сообщение отредактировал Konkruk - Понедельник, 30.12.2019, 12:54
 
Ответить
СообщениеNic70y,
Да все работает, спасибо большое.
Подскажите, если не сложно, еще вопрос, если в этот макрос добавить еще строку для вставки даты в 11 столбец при заполнении 10 (в оригинале просто столбцов больше), правильно ли будет просто скопировать строку и поменять на 10 значение "2": и надо ли добавлять end if еще?
вот так получается:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
    If Target.Column = 10 And Target.Row > 1 And Not IsEmpty(Target.Value) And Target.Offset(0, 1).Value = "" Then _
        Target.Offset(0, 1).Value = Date
     If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
       i = Split(Target.Address, "$")(2)
       LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(Cells(i, 4), "Рос") > 0 Then
          Range("A" & CStr(i) & ":E" & i).Copy Sheets("Лист2").Range("A" & LastRow + 1)
        End If
     End If
End Sub
   
[/vba]
Автор - Konkruk
Дата добавления - 30.12.2019 в 11:51
Nic70y Дата: Понедельник, 30.12.2019, 13:07 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 9005
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
Цитата Konkruk, 30.12.2019 в 11:51, в сообщении № 3 ()
на 10 значение "2"
да

ЮMoney 41001841029809
 
Ответить
Сообщение
Цитата Konkruk, 30.12.2019 в 11:51, в сообщении № 3 ()
на 10 значение "2"
да
Автор - Nic70y
Дата добавления - 30.12.2019 в 13:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос для копирования строки при условии (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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