Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)
-   -   [решено] Поиск строк (http://forum.oszone.net/showthread.php?t=289738)

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

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

Iska 21-10-2014 11:27 2418239
Упакуйте в архив и выложите образцы первой и второй рабочих книг.

Geliosvamp 21-10-2014 11:44 2418249
Вложений: 1
Добавил архив с файлами-примерами

Iska 21-10-2014 12:23 2418261
Примерно так:
читать дальше »
Код:
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 24-10-2014 14:08 2419835
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 24-10-2014 20:35 2420017
Geliosvamp, я не вникал в вашу проблему, но по вашим словам
Цитата:
Цитата 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 25-10-2014 11:48 2420258
Цитата:
Цитата Geliosvamp
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

Рисунок:

P.S. Печально, что в Excel нет операции вычитания диапазонов. Или я просто не нашёл?

Geliosvamp 28-10-2014 10:15 2421393
Iska, огромное спасибо!

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

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

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

Iska 28-10-2014 11:33 2421426
Цитата:
Цитата Geliosvamp
1. это имена - лучше использовать на английском, а то наблюдаю проблемы с кодировкой »
Поясните?

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

Geliosvamp 28-10-2014 12:58 2421466
Iska,
Поясняю примером
Скрытый текст



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

Iska 28-10-2014 13:58 2421516
Geliosvamp, перед копированием текста кода из браузера переключите в нём язык ввода на кириллицу, затем выделите и скопируйте код в буфер обмена. Переключитесь на Ваш редактор, переключите в нём язык ввода на кириллицу, затем вставляйте текст из буфера обмена.

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

Geliosvamp 30-10-2014 13:37 2422544
Цитата:
Цитата Iska
А Вы выделяете перед этим, что потребно цитировать? »
Согласен, я балбес :) Ещё раз спасибо!

Iska 30-10-2014 17:20 2422649
Цитата:
Цитата Geliosvamp
Согласен, я балбес »
А я не согласен. Потому как типовое, привычное поведение на форумах ссылки «Цитировать» именно что не требует предварительного выделения, а цитирует пост целиком. Но здесь — вот так сделано. Просто надо знать, и всё тут ;).


Время: 09:35.

Время: 09:35.
© OSzone.net 2001-