Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение таблицы значениями подходящими под условие.
 
#1
22.06.2021 14:52:14
Всем доброго времени суток ! Сижу уже неделю нечего не выходит :(  . Помогите составить Макрос, нужно автоматически копировать со страницы "Приходы" на страницу "Расход"  все транзакции которые по колонке Нал.\Безнал. идут по категориям: Терминал,Расрочка\кредит. Исходный фал в приложении.
Изменено: Станислав Золин - 23.06.2021 10:49:47
 
 
 
#2
22.06.2021 15:33:21
Код
Option Explicit
Sub CopyIf()
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("G" & i) = "Терминал" Or .Range("G" & i) = "Расрочка\кредит" Then
                .Range("G" & i).EntireRow.Copy ActiveWorkbook.Sheets("Расход").Range("A" & j)
                j = j + 1
            End If
        Next i
    End With
End Sub
Изменено: vokilook - 22.06.2021 15:35:50
 
 
 
#3
22.06.2021 15:56:55
Добрый день! vokilook.  Добавив пару транзакций на страницу Приходы , добавления на страницу Расход не происходит (  
 
 
 
#4
22.06.2021 16:27:04
Цитата
Станислав Золин написал:
нужно автоматически переносить со страницы "Приходы" на страницу "Расход"  все транзакции которые по колонке Нал.\Безнал. дут по категориям: Терминал,Расрочка\кредит.
ничего из приведенного нет в примере - переносить нечего
а так выше макрос переделанный от vokilook
Код
Option Explicit
Sub CopyIf()
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("E" & i) = "Терминал" Or .Range("E" & i) = "Расрочка\кредит" Then
                .Range("E" & i).EntireRow.Copy ActiveWorkbook.Sheets("Расход").Range("A" & j)
                j = j + 1
            End If
        Next i
    End With
End Sub
Изменено: Mershik - 22.06.2021 16:34:14
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
22.06.2021 16:48:54
Цитата
Станислав Золин написал:
автоматически переносить
Код
Option Explicit
Sub CopyIf()
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("G" & i) = "Терминал" Or .Range("G" & i) = "Расрочка\кредит" Then
                .Range("G" & i).EntireRow.Cut ActiveWorkbook.Sheets("Расход").Range("A" & j)
                .Range("G" & i).EntireRow.Delete
                j = j + 1
            End If
        Next i
    End With
End Sub
Изменено: Mershik - 23.06.2021 10:40:37
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
22.06.2021 16:51:49
Добавил кнопку.
Изменено: vikttur - 23.06.2021 10:41:02
 
 
 
#7
23.06.2021 10:36:11
Добавил одну строчку и все заработало !) Насколько я правильно сделал?
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("G" & i) = "Терминал" Or .Range("G" & i) = "Расрочка\кредит" Then
                .Range("G" & i).EntireRow.Copy ActiveWorkbook.Sheets("Расход").Range("A" & j)
                j = j + 1
            End If
        Next i
    End With
End Sub
Изменено: Станислав Золин - 23.06.2021 10:38:58
 
 
 
#8
23.06.2021 12:09:57
Ну если заработало - значит правильно... Только надо иметь ввиду, то, что данные во вкладке "Расход" постоянно перезаписываются без удаления старых данных.
Изменено: vikttur - 23.06.2021 12:45:55
 
 
 
#9
23.06.2021 23:03:07
Как сделать что бы заполнение начиналось с новой строчки ?????
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("G" & i) = "Терминал" Or .Range("G" & i) = "Расрочка\кредит" Then
                .Range("G" & i).EntireRow.Copy ActiveWorkbook.Sheets("Расход").Range("A" & j)
                j = j + 1
            End If
        Next i
    End With
End Sub
Изменено: Станислав Золин - 24.06.2021 22:08:57
 
 
 
#10
28.06.2021 10:15:39
Я так понимаю переделать этот макрос нельзя ?  
 
 
 
#11
28.06.2021 10:28:12
как же его переделаешь
как говорится "что написано пером..."
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
28.06.2021 10:51:46
К  моему большому сожалению переделать сам не в состоянии ( Если поможете, буду безмерно благодарен.  
Изменено: vikttur - 28.06.2021 12:27:12
 
 
 
#13
28.06.2021 10:57:59
вместо
j = 2
напишите
Код
j = ActiveWorkbook.Sheets("Расход").cells(rows.count,1).end(xlup).row+1
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#14
28.06.2021 11:19:27
Я извиняюсь что это сразу не написал , но возможно сделать что бы уже перенесенные строки не копировались снова ?
 
 
 
#15
28.06.2021 11:24:06
))
сможете описать задачу - скорее всего и решение найдется, не сможете - решайте сами или ждите гадалок по опытнее меня, они угадают все что вам нужно и без рассказа о том, что же вам нужно.
но только будьте внимательны, не думайте лишнего, они могут и пин-код от вашей карточки угадать
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#16
28.06.2021 11:51:07
Попытаюсь еще раз описать задачу, строки которые переносяться со страницы Приход на страницу Расход не должны дублироваться . Сейчас внеся изменения написанные Ігор Гончаренко строки записываются каждый раз заново  не учитывая те строки которые уже были записаны. Надеюсь на вашу помощь (
 
 
 
#17
28.06.2021 17:35:42
help me!!!  :(  
 
 
 
Страницы: 1
Наверх