2010

Iska · Отправлено: **11:27, 21-10-2014** | #2

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

Geliosvamp · Отправлено: **11:44, 21-10-2014** | #3

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

Iska · Отправлено: **12:23, 21-10-2014** | #4

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

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

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

Geliosvamp · Отправлено: **14:08, 24-10-2014** | #5

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

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

Можете подсказать как удобнее это сделать?

okshef · Конфигурация компьютера

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 · Отправлено: **11:48, 25-10-2014** | #7

Цитата 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 · Отправлено: **10:15, 28-10-2014** | #8

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

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

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

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

Iska · Отправлено: **11:33, 28-10-2014** | #9

Цитата Geliosvamp:

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

Поясните?

Цитата Geliosvamp:

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

Ну, это я так понял, что именно в этот столбец и надо писать результат

, а цифры в нём — Вы ввели как раз как образец.

Geliosvamp · Отправлено: **12:58, 28-10-2014** | #10

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

Скрытый текст

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