Уважаемые профессионалы по макросам, помогите автоматизировать процесс обработки данных. В прикрепленном файле находятся данные: лист1 - исходная таблица, лист2 - список, по которому должен происходить выбор данных в листе1, лист3 - результат (образец). Буду очень благодарна за помощь.
Уважаемые профессионалы по макросам, помогите автоматизировать процесс обработки данных. В прикрепленном файле находятся данные: лист1 - исходная таблица, лист2 - список, по которому должен происходить выбор данных в листе1, лист3 - результат (образец). Буду очень благодарна за помощь.MayaVO
Макрос в стандартный модуль, запускать при активном Лист2 [vba]
Код
Sub iSumma() Dim List3 As Worksheet Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim FoundCell As Range Dim iSumma As Double Dim Nomer As Integer Set List3 = Worksheets("Лист3") iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 List3.Range("A2:C" & iLR).Clear 'цикл по столбцу А Листа2 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets("Лист1") iSumma = 0 Nomer = 1 For i = 1 To iLastRow Set FoundCell = .Columns(3).Find(Cells(i, 1), , xlValues, xlWhole) If Not FoundCell Is Nothing Then iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 .Range("B" & FoundCell.Row & ":C" & FoundCell.Row).Copy List3.Cells(iLR, 2) List3.Cells(iLR, 1) = Nomer .Range("B" & FoundCell.Row + 2 & ":C" & FoundCell.Row + 2).Copy List3.Cells(iLR + 1, 2) iSumma = iSumma + .Range("C" & FoundCell.Row + 2) Nomer = Nomer + 1 End If Next iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 List3.Cells(iLR + 1, 2) = "Всего:" List3.Cells(iLR + 1, 3) = iSumma End With List3.Activate End Sub
[/vba]
Макрос в стандартный модуль, запускать при активном Лист2 [vba]
Код
Sub iSumma() Dim List3 As Worksheet Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim FoundCell As Range Dim iSumma As Double Dim Nomer As Integer Set List3 = Worksheets("Лист3") iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 List3.Range("A2:C" & iLR).Clear 'цикл по столбцу А Листа2 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row With Worksheets("Лист1") iSumma = 0 Nomer = 1 For i = 1 To iLastRow Set FoundCell = .Columns(3).Find(Cells(i, 1), , xlValues, xlWhole) If Not FoundCell Is Nothing Then iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 .Range("B" & FoundCell.Row & ":C" & FoundCell.Row).Copy List3.Cells(iLR, 2) List3.Cells(iLR, 1) = Nomer .Range("B" & FoundCell.Row + 2 & ":C" & FoundCell.Row + 2).Copy List3.Cells(iLR + 1, 2) iSumma = iSumma + .Range("C" & FoundCell.Row + 2) Nomer = Nomer + 1 End If Next iLR = List3.Cells(Rows.Count, 3).End(xlUp).Row + 1 List3.Cells(iLR + 1, 2) = "Всего:" List3.Cells(iLR + 1, 3) = iSumma End With List3.Activate End Sub
Kuzmich, попробовала работу макроса на таблице с большим количеством позиции. Выявила следующие нюансы: 1. в результате обработки информации макросом на листе 1 должна была остаться таблица, приведенная как образец на листе3; 2. форма получившейся таблицы не соответствует образцу, т.к. строка "реализовано" с итогом по месяцу должна стоять после каждого "продукта"; 3. при работе с большим количеством позиций, копирование данных с листа1 на лист 3 замедляет работу макроса, т.к. результат макроса, как я писала выше, должен остаться на листе1; 4. строка "всего" подсчитывает промежуточные итоги строк "реализовано". Приношу свои извинения, не сумев толково из-за отсутствия опыта аналогичных просьб разъяснить суть просьбы в первом сообщении. Внесла детализация в первоначальный файл. Прошу немного вашего внимания и участия для достижения конечного результата. Премного благодарна за протянутую руку помощи.
Kuzmich, попробовала работу макроса на таблице с большим количеством позиции. Выявила следующие нюансы: 1. в результате обработки информации макросом на листе 1 должна была остаться таблица, приведенная как образец на листе3; 2. форма получившейся таблицы не соответствует образцу, т.к. строка "реализовано" с итогом по месяцу должна стоять после каждого "продукта"; 3. при работе с большим количеством позиций, копирование данных с листа1 на лист 3 замедляет работу макроса, т.к. результат макроса, как я писала выше, должен остаться на листе1; 4. строка "всего" подсчитывает промежуточные итоги строк "реализовано". Приношу свои извинения, не сумев толково из-за отсутствия опыта аналогичных просьб разъяснить суть просьбы в первом сообщении. Внесла детализация в первоначальный файл. Прошу немного вашего внимания и участия для достижения конечного результата. Премного благодарна за протянутую руку помощи.MayaVO
В таком случае на Лист1 надо оставить только те фрукты, которые встречаются на Лист2 [vba]
Код
Sub Tablica() Dim i As Long Dim iLastRow As Long Dim FoundFruit As Range Application.ScreenUpdating = False iLastRow = Cells(Rows.Count, "C").End(xlUp).Row - 3 With Worksheets("Лист2") For i = iLastRow To 2 Step -3 Set FoundFruit = .Columns(1).Find(Cells(i, "C"), , xlValues, xlWhole) If Not FoundFruit Is Nothing Then Rows(i + 1).Delete Else Rows(i & ":" & i + 2).Delete End If Next End With Application.ScreenUpdating = True End Sub
[/vba] Макрос запускать при активном Лист1. В формуле для Всего не нужно включать саму ячейку Всего.
В таком случае на Лист1 надо оставить только те фрукты, которые встречаются на Лист2 [vba]
Код
Sub Tablica() Dim i As Long Dim iLastRow As Long Dim FoundFruit As Range Application.ScreenUpdating = False iLastRow = Cells(Rows.Count, "C").End(xlUp).Row - 3 With Worksheets("Лист2") For i = iLastRow To 2 Step -3 Set FoundFruit = .Columns(1).Find(Cells(i, "C"), , xlValues, xlWhole) If Not FoundFruit Is Nothing Then Rows(i + 1).Delete Else Rows(i & ":" & i + 2).Delete End If Next End With Application.ScreenUpdating = True End Sub
[/vba] Макрос запускать при активном Лист1. В формуле для Всего не нужно включать саму ячейку Всего.Kuzmich
Сообщение отредактировал Kuzmich - Понедельник, 10.04.2017, 11:45