[решено] Поиск строк

[Geliosvamp]

Есть книга xls (можно использовать и xlsx, если надо).
В ней множество листов.
На каждом листе располагается форма учёта техники: то есть некая шапка и самое главное список техники (карточка учета малоценных и быстроизнашивающихся предметов - Типовая межотраслевая форма № МБ-2).
Далее есть второй xls файл - выгрузка из 1С, в котором Наименование, Номер инвентарный и Количество.
Что я хочу.
Я хочу, чтобы каждая позиция из второго файла сравнивалась по инвентарному номеру с первым файлом (с каждым его листом по всей книге) и количество совпадений записывалось в xls- файл (лучше, конечно, во второй файл в столбец рядом с количеством).

В принципе всё сводится к поиску совпадений по всей книге средствами формул - но я не знаю какими формулами воспользоваться для поиска.
Может быть есть и более элегантный метод, может лучше вообще использовать Visual Basic.
Помогите, пожалуйста.

[Iska]

Упакуйте в архив и выложите образцы первой и второй рабочих книг.

[Geliosvamp]

Добавил архив с файлами-примерами

[Iska]

Примерно так:
Option Explicit

Sub CountBy()
Dim objWorksheet As Worksheet
Dim objDictionary As Variant
Dim objRange As Range

Set objDictionary = CreateObject("Scripting.Dictionary")

For Each objWorksheet In Workbooks.Item("Карточка учёта техники.xlsx").Worksheets
For Each objRange In Union(objWorksheet.Range("B16:B35"), objWorksheet.Range("B40:B70"))
If objDictionary.Exists(objRange.Value) Then
objDictionary.Item(objRange.Value) = objDictionary.Item(objRange.Value) + 1
Else
objDictionary.Add objRange.Value, 1
End If
Next
Next

For Each objRange In Intersect(ThisWorkbook.Worksheets.Item("1С").Range("C2:C65536"), ThisWorkbook.Worksheets.Item("1С").Range("C2").CurrentRegion.Columns.Item(3))
If objDictionary.Exists(objRange.Value) Then
objRange.Offset(0, 1).Value = objDictionary.Item(objRange.Value)
Else
objRange.Offset(0, 1).Value = 0
End If
Next

objDictionary.RemoveAll

Set objDictionary = Nothing
End Sub

Вставьте код в модуль «ЭтаКнига» рабочей книги «Копия ИТ_24 09 14 (Выгрузка из 1С).xls». Откройте рабочую книгу «Карточка учёта техники.xlsx». Выполните процедуру «CountBy()» из приведённого кода.

Разумеется, для реальной работы Вам придётся ещё настраивать и настраивать приведённый код под конкретные детали, поскольку это, скорее, макет, не содержащий никаких проверок.

[Geliosvamp]

Iska, спасибо, но для меня без комментариев данный код пока довольно труден.
Покопался на других форумах и нашёл нечто похожее.
В файл Карточка учёта техники.xlsx добавил лист "1С" с информацией из книги «Копия ИТ_24 09 14 (Выгрузка из 1С).xls».
Макрос сделал в виде функции:


Function fndval(rcell As Range) As Double
On Error Resume Next
Dim i&
Dim s&
Dim c As Double
i = 0
s = 0
If rcell.Value <> "" Then
For i = 1 To Sheets.Count
If Not Sheets(i).Name = "1Ñ" Then

s = s + Sheets(i).Cells.Find(What:=rcell.Value, LookIn:=xlValues, LookAt _
:=xlWhole, SearchDirection:=xlNext).Count

End If
Next
End If
fndval = s
End Function


Но есть проблема: метод Find ищет на листе только первое упоминание об искомом элементе, а элементов с одним инвентарным номером на листе может быть несколько.
Пробовал подобрать цикл поиска по листу типа do Findnext until, но у он у меня не работает :( Можете подсказать как удобнее это сделать?

[okshef]

Geliosvamp, я не вникал в вашу проблему, но по вашим словам
метод Find ищет на листе только первое упоминание об искомом элементе, а элементов с одним инвентарным номером на листе может быть несколько. »
предлагаю использовать метод FindNext. Вот пример из справки Excel
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Попробуйте "прикрутить" его к своей задаче

[Iska]

Iska, спасибо, но для меня без комментариев данный код пока довольно труден. »
С комментариями:
Option Explicit

Sub CountBy()
Dim objWorksheet As Worksheet ' Рабочий лист
Dim objDictionary As Variant ' Словарь, коллекция
' Представляет собой неупорядоченный итерируемый набор из пар Ключ/Значение,
' где ключ является уникальным идентификатором пары в наборе.
'
' http://www.script-coding.com/WSH/Dictionary.html
' http://msdn.microsoft.com/en-us/library/x4k5wbx4%28v=vs.84%29.aspx
Dim objRange As Range ' Диапазон

' Создаём экземпляр объекта Automation «Scripting.Dictionary»
Set objDictionary = CreateObject("Scripting.Dictionary")

' Перебираем все рабочие листы из открытой (!) Рабочей книги с именем «Карточка учёта техники.xlsx»
For Each objWorksheet In Workbooks.Item("Карточка учёта техники.xlsx").Worksheets
' Перебираем все ячейки из диапазона, получающегося объединением двух поддиапазонов: «B16:B35» и «B40:B70»
' Эти два поддиапазона содержат номенклатурные номера
For Each objRange In Union(objWorksheet.Range("B16:B35"), objWorksheet.Range("B40:B70"))
' Существует ли в словаре ключ с инвентарным номером из очередной ячейки?
If objDictionary.Exists(objRange.Value) Then
' Если существует — прибавляем к значению ключа единицу
objDictionary.Item(objRange.Value) = objDictionary.Item(objRange.Value) + 1
Else
' Если не существует — создаём пару, используя инвентарный номер в качестве ключа
' и присваиваем в качестве значения единицу
objDictionary.Add objRange.Value, 1
End If
Next
Next
' Таким образом, после завершения перебора всех ячеек из всех рабочих листов книги «Карточка учёта техники.xlsx»
' мы получим в словаре набор пар Ключ/Значение, содержащих все найденные
' инвентарные номера (в качестве ключей) и их количество (в качестве значений), наподобие
'
' Инвентарный номер Количество
' ----------------- ----------
' УЛВ00000290 4
' УЛВ00000406 16
' …
' УЛВ00000377 1
' УЛВ00000565 18
'


' Теперь получаем диапазон, получающегося пересечением двух поддиапазонов
'
' Первый поддиапазон — «C2:C65536»: с рабочего листа «1С» этой Рабочей книги берём почти весь столбец «C», за исключением верхней ячейки
' Второй поддиапазон получается расширением диапазона, состоящего из ячейки «C2», до текущей области, …
'
' «Текущая область» («.CurrentRegion», http://msdn.microsoft.com/en-us/library/office/ff196678%28v=office.15%29.aspx)
' — диапазон, ограниченный любой комбинацией пустых строк и столбцов
' Для лучшего понимания — выполните \Правка\Перейти, Выделить… Текущую область.
'
' … затем от полученной текущей области берётся диапазон, составляющий его третий столбец («.Columns.Item(3)»)
'
' См. рисунок в тексте
'
' В итоге мы получаем диапазон «C2:Cnn», содержащий инвентарные номера
'
' Перебираем все ячейки из полученного таким образом диапазона
For Each objRange In Intersect(ThisWorkbook.Worksheets.Item("1С").Range("C2:C65536"), ThisWorkbook.Worksheets.Item("1С").Range("C2").CurrentRegion.Columns.Item(3))
' Проверяем, наличествует ли в ранее полученном наборе Инвентарный номер/Количество
' инвентарный номер из очередной ячейки?
If objDictionary.Exists(objRange.Value) Then
' Если наличествует — в соседнюю ячейку справа записываем ранее подсчитанное количество
objRange.Offset(0, 1).Value = objDictionary.Item(objRange.Value)
Else
' Если отсутствует — в соседнюю ячейку справа записываем нуль
objRange.Offset(0, 1).Value = 0
End If
Next

' Очищаем словарь
objDictionary.RemoveAll

' Освобождаем экземпляр объекта Automation
Set objDictionary = Nothing
End Sub

Рисунок:
http://i.imgur.com/Us8G2Fi.png
P.S. Печально, что в Excel нет операции вычитания диапазонов. Или я просто не нашёл?

[Geliosvamp]

Iska, огромное спасибо!

Код работает как надо.

Единственное, что переделал:
1. это имена - лучше использовать на английском, а то наблюдаю проблемы с кодировкой
2. заменил в последнем цикле Offcet с 1 на 2, а то число позиций на складе заменялось выданными (видимо этого я и не заметил в первый раз и думал, что скрипт что-то недоделывал)

PS: okshef, я пробовал, но у меня что-то с таким циклом не вышло ничего. Убив больше времени на изучение синтаксиса, думаю получилось бы, но уже не надо :)

[Iska]

1. это имена - лучше использовать на английском, а то наблюдаю проблемы с кодировкой »
Поясните?

2. заменил в последнем цикле Offcet с 1 на 2, а то число позиций на складе заменялось выданными (видимо этого я и не заметил в первый раз и думал, что скрипт что-то недоделывал) »
Ну, это я так понял, что именно в этот столбец и надо писать результат ;), а цифры в нём — Вы ввели как раз как образец.

[Geliosvamp]

Iska,
Поясняю примером

http://i.imgur.com/KCb2QTA.jpg

PS: что-то в Google Chrome цитирование не работает (

[Iska]

Geliosvamp, перед копированием текста кода из браузера переключите в нём язык ввода на кириллицу, затем выделите и скопируйте код в буфер обмена. Переключитесь на Ваш редактор, переключите в нём язык ввода на кириллицу, затем вставляйте текст из буфера обмена.

PS: что-то в Google Chrome цитирование не работает ( »
А Вы выделяете перед этим, что потребно цитировать?

[Geliosvamp]

А Вы выделяете перед этим, что потребно цитировать? »
Согласен, я балбес :) Ещё раз спасибо!

[Iska]

Согласен, я балбес »
А я не согласен. Потому как типовое, привычное поведение на форумах ссылки «Цитировать» именно что не требует предварительного выделения, а цитирует пост целиком. Но здесь — вот так сделано. Просто надо знать, и всё тут ;).