День добрый. На листе База в столбце А содержатся данные для поиска, в столбце В числа Прошу вашего содействия в решении задачи предполагающей, если при открытой книге в конкретном листе Результат (не открытом) в буфер обмена "внести" (Ctrl+C) данные для поиска, то макрос бы автоматически прошелся по столбцу А листа База и просуммировал соседние с найденным значением числа столбца В. А результат (сумму) вписал в лист Результат в соседнюю справа ячейку от ячейки содержащей Итого:. Например: копирую слово Иванов и запускаю макрос из книги макросов на рабочем столе, код суммирует 2,05+5+6 и результат 13,05 вставляет в лист Результат в ячейку E6, т.к. рядом в ячейке D6 (постоянен только столбец D) находится Итог: Названия листов постоянны. К буферу обмена привязался ,т.к. это экономит время.
День добрый. На листе База в столбце А содержатся данные для поиска, в столбце В числа Прошу вашего содействия в решении задачи предполагающей, если при открытой книге в конкретном листе Результат (не открытом) в буфер обмена "внести" (Ctrl+C) данные для поиска, то макрос бы автоматически прошелся по столбцу А листа База и просуммировал соседние с найденным значением числа столбца В. А результат (сумму) вписал в лист Результат в соседнюю справа ячейку от ячейки содержащей Итого:. Например: копирую слово Иванов и запускаю макрос из книги макросов на рабочем столе, код суммирует 2,05+5+6 и результат 13,05 вставляет в лист Результат в ячейку E6, т.к. рядом в ячейке D6 (постоянен только столбец D) находится Итог: Названия листов постоянны. К буферу обмена привязался ,т.к. это экономит время.timo64uk
Sub SumClip() Dim x As String, Cl As Range, Sm As Double With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard x = WorksheetFunction.Clean(.GetText(1)) End With For Each Cl In Sheets("База").Range("A2:A100") If Cl = x Then Sm = Sm + Cl.Offset(, 1) Next Sheets("Результат").Range("E6") = Sm End Sub
[/vba]
Здравствуйте. Попробуйте такой код. [vba]
Код
Sub SumClip() Dim x As String, Cl As Range, Sm As Double With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard x = WorksheetFunction.Clean(.GetText(1)) End With For Each Cl In Sheets("База").Range("A2:A100") If Cl = x Then Sm = Sm + Cl.Offset(, 1) Next Sheets("Результат").Range("E6") = Sm End Sub
For Each Cl In Sheets("База").Range("A2:A100") If Cl = x Then Sm = Sm + Cl.Offset(, 1) Next
А цикл-то зачем? Есть же аналог функции СУММЕСЛИ в WorksheetFunction: [vba]
Код
Sub SumClip() Dim x As String, Cl As Range, Sm As Double With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard x = WorksheetFunction.Clean(.GetText(1)) End With Set Cl = Sheets("База").Range("A2:A100") Sheets("Результат").Range("E6") = WorksheetFunction.SumIf(Cl, x, Cl.Offset(, 1)) End Sub
For Each Cl In Sheets("База").Range("A2:A100") If Cl = x Then Sm = Sm + Cl.Offset(, 1) Next
А цикл-то зачем? Есть же аналог функции СУММЕСЛИ в WorksheetFunction: [vba]
Код
Sub SumClip() Dim x As String, Cl As Range, Sm As Double With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard x = WorksheetFunction.Clean(.GetText(1)) End With Set Cl = Sheets("База").Range("A2:A100") Sheets("Результат").Range("E6") = WorksheetFunction.SumIf(Cl, x, Cl.Offset(, 1)) End Sub
Спасибо. type mismatch в сообщении предупреждает и подсвечивает, вероятно я что-то не то сделал, т.к. вчера со своим кодом мучался и схожая ошибка выскакивала [vba]
[/vba] здесь идет вставка в ячейку E6 без учета Итог: Я допустил ошибку в описании, сказав что (постоянен только столбец D), где находится Итог:, но имел ввиду, что Итог: может находится только в этом столбце D, а так то Итог: перемещается от D3 до D999999. Прошу прощения. Учту.
Спасибо. type mismatch в сообщении предупреждает и подсвечивает, вероятно я что-то не то сделал, т.к. вчера со своим кодом мучался и схожая ошибка выскакивала [vba]
[/vba] здесь идет вставка в ячейку E6 без учета Итог: Я допустил ошибку в описании, сказав что (постоянен только столбец D), где находится Итог:, но имел ввиду, что Итог: может находится только в этом столбце D, а так то Итог: перемещается от D3 до D999999. Прошу прощения. Учту.timo64uk
Сообщение отредактировал timo64uk - Понедельник, 30.09.2024, 02:56