Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос, вставляющий коды по заданному условию через запятую
 
Помогите пожалуйста написать макрос. На листе 1 есть исходная таблица, необходимо проставить в таблицу на листе 2 значения каждой ТТ и коды товаров, пригодность которых составляет 1 через запятую в соответствующую неделю. Запускаю макрос, он пишет ошибку на моменте вычисления функции поискпоз. Не понимаю что не так?
 
А эта функция не подойдет? Как сцепить несколько значений в одну ячейку по критерию? СцепитьЕсли
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
C допстолбцом можно применить UDF VLOOKUPCOUPLE() из копилки.
 
Код
Sub perenos()
Dim iz As Worksheet
Dim v As Worksheet
Set iz = Worksheets(1)
Set v = Worksheets(2)
Dim i&, j As Long
Dim rez, ar, dic, nm
With iz.Range("A1").CurrentRegion
    col = .Columns.Count
    r = .Rows.Count
End With
With v.Range("A1").CurrentRegion
    col2 = .Columns.Count
    r2 = .Rows.Count
End With
ar = iz.Cells(1).Resize(, col)
tov = WorksheetFunction.Match("Товар", ar, 0)
tt = WorksheetFunction.Match("ТТ", ar, 0)
ned = WorksheetFunction.Match("неделя", ar, 0)
prig = WorksheetFunction.Match("пригодность", ar, 0)
ar = iz.Cells(1).CurrentRegion
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next
For i = 2 To r
 If ar(i, prig) > 0 Then
    dic.Add ar(i, tt), dic.Count + 1
    If nm < ar(i, ned) Then nm = ar(i, ned)
End If
Next i
ReDim rez(1 To dic.Count, 1 To nm + 1)
For i = 2 To r
    If ar(i, prig) > 0 Then
        j = dic(ar(i, tt))
        If rez(j, ar(i, ned) + 1) = Empty Then
            rez(j, ar(i, ned) + 1) = "'" & ar(i, tov)
            rez(j, 1) = ar(i, tt)
        Else
            rez(j, ar(i, ned) + 1) = rez(j, ar(i, ned) + 1) & "," & ar(i, tov)
        End If
    End If
Next i
Set dic = Nothing
v.Cells(3, 1).Resize(UBound(rez), UBound(rez, 2)) = rez
End Sub
Изменено: Слэн - 21 Апр 2013 16:26:36
Живи и дай жить..
Страницы: 1
Читают тему (гостей: 1)
Наверх