vba, который ищет значение, если оно соответствует, находит ближайшую дату

я написал код для рабочей книги, которая имеет два рабочих листа, в ProximoPedido (лист) в столбце «A» есть диапазон значений (целое число), а в столбце «B» есть связанная дата, а в в ChekingList (листе) есть столбец «A» со значениями (которые должны совпадать с «A» ProximoPedido) и столбец «E» с датами. Если значение ячейки A в CheckingList совпадает со значением «A» в ProximoPedido, выполните поиск в «E» в ChekingList для следующей (или ближайшей более высокой) даты «B» из ProximoPedido.

Лист: контрольный список

A-----------------------------------------E

1----------------------------------2009-10-30 12:00

3 ---------------------------------2009-10-29 13:00

2---------------------------------2009-10-29 12:20

50--------------------------------2009-10-19 10:20

24--------------------------------2009-10-28 10:20

3---------------------------------28-10-2009 10:20 ‹------ -- ( СООТВЕТСТВИЕ!)

Лист: Проксимо Педидо

A----------------------------------------B

4----------------------------------2009-10-28 10:20

20---------------------------------2009-10-29 13:00

3----------------------------------2009-10-19 15:20

24---------------------------------2009-10-29 13:40

3----------------------------------27-10-2009 13:20 ‹----- ------- (пример)

Сначала я написал формулу с условием VLOOKUP, а другую с INDEX MATCH, но VLOOKUP дал мне последнее значение всех дат в CheckingList, а затем я попробовал этот код: Sub TempoTotal1()

    Dim CheckingList As Worksheet
    Dim ProximPedido As Worksheet
    Dim tear1 As Range
    Dim inicio As Range
    Dim tear2 As Range
    Dim saida As Range
    Dim diferença As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim i As Integer





Set tear1 = Worksheets("CheckingList").Range("a2").CurrentRegion
Set inicio = Worksheets("CheckingList").Range("e2").CurrentRegion
Set tear2 = Worksheets("ProximoPedido").Range("a1").CurrentRegion
Set saida = Worksheets("ProximoPedido").Range("b2").CurrentRegion
Set diferença = Worksheets("ProximoPedido").Range("c2").CurrentRegion



On Error Resume Next

For Each cell1 In tear1
If tear1.Cells.Value = tear2.Cells.Value Then

For Each cell2 In inicio


If tear2.Cells.Value > saida.Cells.Value Then
diferença.Cells.Value = inicio.Cells.Value - saida.Cells.Value

End If
Exit For
Next cell2


End If
Exit For
Next cell1








End Sub

Спасибо


person Pedro Celso    schedule 14.05.2013    source источник


Ответы (1)


Настройте 2 переменные в вашем коде

  1. Первый будет отслеживать местоположение ячейки DIM MatchCell as Range
  2. Второй будет отслеживать дельту между исходной ячейкой и ячейкой Match Dim Targetdelta as Double.

Теперь прокрутите данные на листе: Proximo Pedido, выполнив следующие логические шаги.

  1. Вычислить абсолютную разницу между датой в текущей ячейке и датой в контрольном списке.
  2. ЕСЛИ эта дельта меньше текущего значения Targetdelta
  3. ЗАТЕМ обновите дельту до нового значения и запишите текущий адрес в переменную MatchCell.
  4. Продолжить цикл
  5. После цикла вы знаете, какая ячейка была ближайшей — она хранится в переменной MatchCell.
person Declan_K    schedule 14.05.2013