Доброе время всем! Недавно в бухгалтерии попросили помочь с формированием и обработкой отчетов. Так вот, есть книга excel, в ней есть n-ное количество листов (более 300) и последний лист "итоги". В листе "итоги" таблица с инвентаризационными номерами и количеством материалов в каждом. В листах "Лист 1", "Лист 2", "Лист 3",... "Лист n" содержатся точно такиеже таблицы как и в листе "итоги" только количество записей в каждой по 20 строк. Количество материалов в листе "итоги" вводится в ручную. А задача состоит в том что после запуска макроса макрос должен перебирать таблицу итоги по порядку, искать соответствующий инвентаризационный номер в книге (поиск производется во всей книге, кроме листа "итоги"), и если найдется вводить количество в найденной таблице.
Прототип книги прилагается.
Вот мои попытки:
[vba]
Код
Sub Макрос11() Dim rr As Range, k As Integer, j As Integer k = Sheets("итоги").UsedRange.Rows.Count Sheets("итоги").Select Range("B2").Select For j = 2 To k Step 1 Range("B" & j).Select Set rr = Cells.Find(What:=Sheets("итоги").Cells(j, 2).Value, SearchDirection:=xlNext) If Not rr Is Nothing And rr.Column = 1 Then rr.Offset(, 5).Value = Sheets("итоги").Cells(j, 3).Value End If Next j End Sub
[/vba]
но только поиск тут пропочемуто проводится не по книге а по листу. Также нужен диапозон поиска но как это все реализовать? Если есть возможность, пожалуйста помогите с советами.
Доброе время всем! Недавно в бухгалтерии попросили помочь с формированием и обработкой отчетов. Так вот, есть книга excel, в ней есть n-ное количество листов (более 300) и последний лист "итоги". В листе "итоги" таблица с инвентаризационными номерами и количеством материалов в каждом. В листах "Лист 1", "Лист 2", "Лист 3",... "Лист n" содержатся точно такиеже таблицы как и в листе "итоги" только количество записей в каждой по 20 строк. Количество материалов в листе "итоги" вводится в ручную. А задача состоит в том что после запуска макроса макрос должен перебирать таблицу итоги по порядку, искать соответствующий инвентаризационный номер в книге (поиск производется во всей книге, кроме листа "итоги"), и если найдется вводить количество в найденной таблице.
Прототип книги прилагается.
Вот мои попытки:
[vba]
Код
Sub Макрос11() Dim rr As Range, k As Integer, j As Integer k = Sheets("итоги").UsedRange.Rows.Count Sheets("итоги").Select Range("B2").Select For j = 2 To k Step 1 Range("B" & j).Select Set rr = Cells.Find(What:=Sheets("итоги").Cells(j, 2).Value, SearchDirection:=xlNext) If Not rr Is Nothing And rr.Column = 1 Then rr.Offset(, 5).Value = Sheets("итоги").Cells(j, 3).Value End If Next j End Sub
[/vba]
но только поиск тут пропочемуто проводится не по книге а по листу. Также нужен диапозон поиска но как это все реализовать? Если есть возможность, пожалуйста помогите с советами.Centuriy
Sub fnd() Application.ScreenUpdating = False Dim rCell As Range, lRow&, sh As Worksheet, sRange$, rRange As Range For Each sh In ThisWorkbook.Worksheets If sh.Name <> "Итог" Then Set rRange = sh.Cells.Find(What:="инв", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Not rRange Is Nothing Then sRange = sh.Cells(rRange.Row + 1, rRange.Column).Address For Each rCell In sh.Range(sRange & ":$B$" & sh.Cells(1048576, rRange.Column).End(xlUp).Row) If rCell.Value <> "" Then lRow = Sheets("Итог").Range("B1048576").End(xlUp).Row + 1 Sheets("Итог").Range("B" & lRow).Value = rCell.Value Sheets("Итог").Range("B" & lRow).Offset(0, 1).Value = rCell.Offset(0, 2).Value End If Next End If End If Next Set rRange = Nothing Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub fnd() Application.ScreenUpdating = False Dim rCell As Range, lRow&, sh As Worksheet, sRange$, rRange As Range For Each sh In ThisWorkbook.Worksheets If sh.Name <> "Итог" Then Set rRange = sh.Cells.Find(What:="инв", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Not rRange Is Nothing Then sRange = sh.Cells(rRange.Row + 1, rRange.Column).Address For Each rCell In sh.Range(sRange & ":$B$" & sh.Cells(1048576, rRange.Column).End(xlUp).Row) If rCell.Value <> "" Then lRow = Sheets("Итог").Range("B1048576").End(xlUp).Row + 1 Sheets("Итог").Range("B" & lRow).Value = rCell.Value Sheets("Итог").Range("B" & lRow).Offset(0, 1).Value = rCell.Offset(0, 2).Value End If Next End If End If Next Set rRange = Nothing Application.ScreenUpdating = True End Sub
SkyPro, спасибо за быстрый ответ, но это что-то не то... пожалуйста объясните что делает этот макрос... он ищет слово "инв"? и что оно возвращает при нахождении? а можно сделать так, чтобы при нахождении совпадений он вставлял данные с столбца количество (лист "итог") на аналогичный столбец в других листах? [moder]Centuriy, не нужно полностью цитировать сообщения, отвечать можно и без цитат[/moder]
SkyPro, спасибо за быстрый ответ, но это что-то не то... пожалуйста объясните что делает этот макрос... он ищет слово "инв"? и что оно возвращает при нахождении? а можно сделать так, чтобы при нахождении совпадений он вставлял данные с столбца количество (лист "итог") на аналогичный столбец в других листах? [moder]Centuriy, не нужно полностью цитировать сообщения, отвечать можно и без цитат[/moder]Centuriy
Sub fnd() On Error Resume Next Dim rcell As Range, lRow&, i& lRow = Sheets("итог").Range("b1048576").End(xlUp).Row For Each rcell In Sheets("итог").Range("b2:b" & lRow) If rcell.Value <> "" Then For i = 1 To Sheets.Count If Not Sheets(i).Name = "итог" Then rcell.Offset(0, 1).Value = Sheets(i).Cells.Find(What:=rcell.Value, After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(0, 2).Value End If Next End If Next End Sub
[/vba]
UDF: [vba]
Код
Function fndval(rcell As Range) As Double On Error Resume Next Dim i& If rcell.Value <> "" Then For i = 1 To Sheets.Count If Not Sheets(i).Name = "итог" Then fndval = Sheets(i).Cells.Find(What:=rcell.Value, After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(0, 2).Value End If Next End If End Function
[/vba]
[offtop]Прошу прощения, что не поместил все в один пост. Завтыкал :).
Macro:[vba]
Код
Sub fnd() On Error Resume Next Dim rcell As Range, lRow&, i& lRow = Sheets("итог").Range("b1048576").End(xlUp).Row For Each rcell In Sheets("итог").Range("b2:b" & lRow) If rcell.Value <> "" Then For i = 1 To Sheets.Count If Not Sheets(i).Name = "итог" Then rcell.Offset(0, 1).Value = Sheets(i).Cells.Find(What:=rcell.Value, After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(0, 2).Value End If Next End If Next End Sub
[/vba]
UDF: [vba]
Код
Function fndval(rcell As Range) As Double On Error Resume Next Dim i& If rcell.Value <> "" Then For i = 1 To Sheets.Count If Not Sheets(i).Name = "итог" Then fndval = Sheets(i).Cells.Find(What:=rcell.Value, After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(0, 2).Value End If Next End If End Function
[/vba]
[offtop]Прошу прощения, что не поместил все в один пост. Завтыкал :).SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Понедельник, 07.10.2013, 12:16
Здравствуйте, мне бы очень пригодился этот макрос в работе, но только в более усложненном варианте. помогите, пожалуйста, а то мне самой никак. В "Свод" таблица должна собираться информация согласно кода по столбцу В из остальных листов в столбцы, выделенные оранжевым цветом, с разбивкой по месяцам и видам имущества. Спасибо!
Здравствуйте, мне бы очень пригодился этот макрос в работе, но только в более усложненном варианте. помогите, пожалуйста, а то мне самой никак. В "Свод" таблица должна собираться информация согласно кода по столбцу В из остальных листов в столбцы, выделенные оранжевым цветом, с разбивкой по месяцам и видам имущества. Спасибо!Nast_na
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
