Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование строк, содержащих признак, на другие листы
 
#1
14.01.2020 12:30:28
Здравствуйте я совсем недавно начала изучать VBA, очень нужен совет по коду:
Код
Sub Test()
Dim iCell As Range, Priznak As Variant
    Priznak = Application.InputBox("признак переноса сроки", "Екатеринбург", "Екатеринбург")
        For Each iCell In Range("A2", [A2].End(xlDown))
             If iCell = Priznak Then
                With Sheets("ЕКБ")
                    iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A")
            End With
        End If
    Next iCell
    MsgBox "строки содержащие" & Priznak & "в столбце а скопированы на другой лист", vbInformation, ""
End Sub

вообщем надо копировать информацию с основного листа содержащую признак на выбранную вкладку, и проверять если данные уже заполнены, не копировать.
как сделать по двум/трем и более признакам не доходит, в общем как и проверку сделать. Помогите((
 
 
 
#2
14.01.2020 12:48:29
Приложите файл пример где должно быть как есть и как надо, ну и желательно с описанием.
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
14.01.2020 12:52:19
Код
Sub Test()
    Dim iCell As Range
    Dim Priznak1 As Variant
    Priznak1 = Application.InputBox("признак переноса сроки", "Екатеринбург", "Екатеринбург")
        
    Dim Priznak2 As Variant
    Priznak2 = Application.InputBox("признак переноса сроки", "Сахар", "Сахар")
        
    Dim Priznak3 As Variant
    Priznak3 = Application.InputBox("признак переноса сроки", "Вагон", "Вагон")
        
        For Each iCell In Range("A2", [A2].End(xlDown))
            If iCell.Cells(1, 1).Value = Priznak1 Then
            If iCell.Cells(1, 2).Value = Priznak2 Then
            If iCell.Cells(1, 3).Value = Priznak3 Then
                With Sheets("ЕКБ")
                    If WorksheetFunction.CountIfs(.Columns(1), Priznak1, .Columns(2), Priznak2, .Columns(3), Priznak3) = 0 Then
                        iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A")
                    End If
                End With
            End If
            End If
            End If
    Next iCell
    MsgBox "строки содержащие" & Priznak1 & "в столбце а скопированы на другой лист", vbInformation, ""
End Sub
 
 
 
#4
14.01.2020 12:52:58
Цитата
lenatoy написал:
как сделать по двум/трем и более признакам

например так - указать признак через разделитель, например запятую


Код
Sub Test()
    Dim iCell As Range, Priznak As Variant
    Priznak = Application.InputBox("признак переноса сроки", "Екатеринбург", "Екатеринбург")
    Priznak = Split(Priznak, ",")

    For Each iCell In Range("A2", [A2].End(xlDown))
        For i = lbound(Priznak) To Ubound(Priznak)
            If iCell = Priznak(i) Then
                With Sheets("ЕКБ")
                    iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A")
                End With
            End If
        Next i
    Next iCell
    MsgBox "строки скопированы на другой лист", vbInformation, ""
End Sub


а вообще лучше с файлом, конечно.
 
 
 
#5
14.01.2020 13:15:13
пример
 
 
 
#6
14.01.2020 13:53:13
Пример
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#7
14.01.2020 14:01:33
Спасибо огромное, это гениально!)
 
 
 
#8
15.01.2020 14:41:43
На вкладке "MyMacros", кнопка "Перенос данных на листы"
Но работать придется в этом файле, либо перенести все модули в свою книгу и вывести кнопку с привязкой к макрос.
Добавил проверку наличия таблицы на искомом листе.
Изменено: Nordheim - 15.01.2020 16:08:02
"Все гениальное просто, а все простое гениально!!!"
 
 
 
Страницы: 1
Наверх