powered by simpleCommunicator - 2.0.57     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос Excel для поиска по всей книге
3 сообщений из 3, страница 1 из 1
Макрос Excel для поиска по всей книге
    #38418462
Centuriy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Доброе время всем!
Недавно в бухгалтерии попросили помочь с формированием и обработкой отчетов.
Так вот, есть книга excel, в ней есть n-ное количество листов (более 300) и последний лист "итоги".
В листе "итоги" таблица с инвентаризационными номерами и количеством материалов в каждом. В листах "Лист 1",
"Лист 2", "Лист 3",... "Лист n" содержатся точно такиеже таблицы как и в листе "итоги" только количество записей
в каждой по 20 строк.
Количество материалов в листе "итоги" вводится в ручную. А задача состоит в том что после запуска макроса макрос должен перебирать таблицу итоги по порядку, искать соответствующий инвентаризационный номер в книге
(поиск производется во всей книге, кроме листа "итоги"), и если найдется вводить количество
в найденной таблице.

Прототип книги прилагается.

Вот мои попытки:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
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



но только поиск тут почему то проводится не по книге а по листу.
Также нужен диапазон поиска но как это все реализовать?
Если есть возможность, пожалуйста помогите с советами.
...
Рейтинг: 0 / 0
Макрос Excel для поиска по всей книге
    #38419073
Centuriy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо ребятам с форумов excelworld и excel-vba. Выкладываю ответ может кому понадобится в будущем:
Вариант1
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
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


Вариант2
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
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 


Вариант3
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Sub Finder() 
Dim Rng As Range, i As Integer, j As Long, LastRow As Long, Freerow As Long, Inv
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
'    Range(Cells(2, 3), Cells(LastRow + 1, 3)).ClearContents
'    Freerow = 2
    For i = 2 To LastRow
        Inv = Cells(i, 2)
        For j = 1 To Sheets.Count - 1
            With Sheets(j)
                Set Rng = .Columns(2).Find(what:=Inv, LookIn:=xlValues, lookAt:=xlWhole)
                If Not Rng Is Nothing Then
                    Rng.Offset(0, 1) = Cells(i, 3)
                End If
            End With
        Next
'        Freerow = Freerow + 1
    Next
End Sub
...
Рейтинг: 0 / 0
Макрос Excel для поиска по всей книге
    #38578886
Фотография DarkTempteition
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Могу посоветовать источник весьма занимательный советую здесь поискать ответ на ваш вопрос
...
Рейтинг: 0 / 0
3 сообщений из 3, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос Excel для поиска по всей книге
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]