1

Тема: Excel скрипт сбора данных

Доброго времени суток!
Столкнулся с проблемой создания скрипта в Excel, к сожалению в этом практически ничего не понимаю, поэтому прошу помощи, очень хочу разобраться как же это сделать можно.

Есть файл Excel в котором два листа: первый лист таблица, на второй лист привязан тестовый документ с данными которые записываются на второй лист в три столбца: название объекта - материал - паспорт
Смысл в том что бы при определенном значении одной из ячеек на листе 1 (название объекта) в соседнюю ячейку записывались все значения материалов и паспортов соответствующие с листа 2 соответствующие объекту.

подсказали вот такой скрипт:

Public Function ListByDate(cDate, rLookupRange,iReturnCol1, iReturnCol2)
iRowCount = rLookupRange.sheet.usedrange.rows.count
ListByDate=""
for each cell in rLookupRange.Columns(1).cells
if cell.value2=cDate.value2 then
ListByDate=ListByDate+cells(cell.row,iRe turnCol1)+cells(cell.row,iReturnCol2) = vbNewLine
end if
if cell.row>iRowCount 
Exit function
End if
Next
End Function

но он мне выдает ошибки при работе с ним.

Помогите разобраться.

2

Re: Excel скрипт сбора данных

DRC, без исходных данных внятного разговора не получится.

3 (изменено: DRC, 2012-06-19 08:56:06)

Re: Excel скрипт сбора данных

alexii если я правильно то по ссылке ниже пример того, что я сделал.
пример
к листу два привязан текстовый документ mat

4

Re: Excel скрипт сбора данных

Почему у Вас в примере повторяются значения в ключевом поле, по которому осуществляется выбор («ОбъектXX») — на листе «mat»?

5

Re: Excel скрипт сбора данных

alexii потому, что для одного объекта может быть несколько видом материалов и соответственно сертификатов к ним

6

Re: Excel скрипт сбора данных

Как Вы предлагаете пользователю отличать их? У меня, например, список подстановки на листе «Лист1» отображается в виде:

объект1
объект1
объект1
объект2
объект2
объект2
объект3
объект3
объект3

7 (изменено: DRC, 2012-06-20 09:03:48)

Re: Excel скрипт сбора данных

alexii, список на первом листе сделан просто для удобства - в принципе в данной ячейке можно название и в ручную ввести - главное, что при выборе скажем "объект1" в соседнюю ячейку записались все данные из столбца 2 и 3 второго листа соответствующие всем записям с названием "объект1".

А у меня тупик, вообще не могу понять как это можно сделать...

если выбирать одно значение то формула

=ЕСЛИОШИБКА(ВПР(Лист1!А1;Лист2!А:С;2;0);"")

работает и устраивает на 100%, но цель что бы объединяло все данные

8

Re: Excel скрипт сбора данных

Одной формулой, конечно, можно сделать. Но формула будет просто гигантская и жёстко будет привязана к числу строк в исходном файле. Лучше использовать пользовательскую функцию.

Переименуйте рабочий лист с исходными данными в «Materials». Вставьте в рабочую книгу модуль. Добавьте в этот модуль подобный текст:

Option Explicit

Function FindMaterials(objCell As Range)
    Dim objRange As Range
    Dim strValue As String
    
    Application.Volatile
    
    strValue = ""
    
    For Each objRange In ThisWorkbook.Sheets.Item("Materials").UsedRange.Rows
        With objRange.Cells
            If .Item(1, 1).Value = objCell.Item(1, 1).Value Then
                strValue = strValue & .Item(1, 2).Value & " " & .Item(1, 3).Value & vbLf
            End If
        End With
    Next
    
    strValue = Left(strValue, Len(strValue) - 1)
    
    FindMaterials = strValue
End Function

Используйте указанную пользовательскую функцию на рабочем листе в ячейках второго столбца, указав аргументом пользовательской функции ячейку, содержимое которой будет искаться в первом столбце переименованного листа «Materials», например:

=FindMaterials(A1)

P.S. Если не совладаете — пишите, выложу готовый пример.

9

Re: Excel скрипт сбора данных

alexii огромное спасибо! заработало!
очень-очень выручили!

10

Re: Excel скрипт сбора данных

DRC, немного поправил код:

Function FindMaterials(objCell As Range)
    Dim objRange As Range
    Dim strValue As String
    
    Application.Volatile
    
    strValue = ""
    
    For Each objRange In ThisWorkbook.Sheets.Item("Materials").UsedRange.Rows
        With objRange.Cells
            If .Item(1, 1).Value = objCell.Item(1, 1).Value Then
                strValue = strValue & .Item(1, 2).Value & " " & .Item(1, 3).Value & vbLf
            End If
        End With
    Next
    
    If Len(strValue) <> 0 Then
        strValue = Left(strValue, Len(strValue) - 1)
    End If
    
    FindMaterials = strValue
End Function

11

Re: Excel скрипт сбора данных

alexii спасибо, понял как работает и как им пользоваться и модернизировать!