Страницы: 1
RSS
Макрос поиска результатов по нескольким аргументам, Нужно выбрать из общего массива определенные значения по трем аргументам
 
Доброго времени суток уважаемые форумчане! В очередной раз обращаюсь к вам за помощью в решении задачки. Кратко - в примере два листа первый исходные данные, второй, то что нужно получить. В итоговой таблице нужно по составляющим (дата/вопрос/имя) вывести результат из листа с исходными данными в необходимую ячейку. Формулами возможно реализовать, но в итоге очень долго пересчитывает (т.к. оригинальный файл содержит очень много данных и к именам в итоговой таблице так же формулами подтягиваются дополнительная инфа с помощью использования динамического диапазона, так как данные берутся из другого источника и могут обновляться ежедневно, и таких строк порядка 2000-4000) в общем если добавлять вывод результата формулами то пересчет идет очень долго, порядка часа - полутора это минимум... В общем если кто может помочь реализовать вывод данных макросом буду безмерно признателен.Так же в итоговой таблице кол-во вопросов не ограничено определенным числом, т.е. их может быть как три так и десять... Это желательно тоже учесть по строке... Пробовал формулу в макросе с отключением вычислений а затем включением (макрос по строке с вопросами протягивал формулу до первой пустой ячейки и аналогично вниз), к сожалению проблема осталась, очень долго считает и висит файл (проц на 100% нагружает)... Очень прошу помощи или совета.
 
Макрос в стандартный модуль, запускать при активном листе Исходные
Код
Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundName As Range
Dim FoundDate As Range
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 With Worksheets("Нужно получить")
  For i = 2 To iLastRow
    Set FoundName = .Columns("A").Find(Cells(i, "A"), , xlValues, xlWhole)
    If Not FoundName Is Nothing Then
      Set FoundDate = .Rows(1).Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not FoundDate Is Nothing Then
          If .Cells(2, FoundDate.Column) = Cells(i, "C") Then
            .Cells(FoundName.Row, FoundDate.Column) = Cells(i, "D")
          End If
        End If
    End If
  Next
   .Activate
   .Range("A1").Select
 End With
Application.ScreenUpdating = True
End Sub
 
Цитата
Kuzmich написал:
Макрос в стандартный модуль, запускать при активном листе Исходные
Спасибо огромное, работает, очень мне помогли
 
minion, и зачем здесь цитата? На чём хотели сделать акцент?
 
Снова возвращаюсь к вопросу... Столкнулся со следующей проблемой, при наличии повторяющихся дат выдает значение только первой, последующую пропускает... Помогите исправить пожалуйста, чтобы искал по порядку все до последней заполненной ячейке в строке в примере на листе "Нужно получить" добавил повторяющуюся дату но с другим вопросом...
Изменено: minion - 17.04.2017 11:30:59
 
Цитата
при наличии повторяющихся дат
Код
Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundName As Range
Dim FoundDate As Range
Dim FAdr As String
Application.ScreenUpdating = False
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 With Worksheets("Нужно получить")
  For i = 2 To iLastRow
    Set FoundName = .Columns("A").Find(Cells(i, "A"), , xlValues, xlWhole)
    If Not FoundName Is Nothing Then
      Set FoundDate = .Rows(1).Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not FoundDate Is Nothing Then
            FAdr = FoundDate.Address
          Do
            If .Cells(2, FoundDate.Column) = Cells(i, "C") Then
              .Cells(FoundName.Row, FoundDate.Column) = Cells(i, "D")
            End If
            Set FoundDate = .Rows(1).FindNext(FoundDate)
          Loop While FoundDate.Address <> FAdr
        End If
    End If
  Next
   .Activate
   .Range("A1").Select
 End With
Application.ScreenUpdating = True
End Sub
 
Спасибо снова за помощь.  
Страницы: 1
Наверх