Макрос, который ищет значение в ячейке и затем вставляет диапазон в столбец этой ячейки. EXCEL 2007

Question

Я пытаюсь написать код VBA, который автоматизирует шаг, который я делаю каждый день, но просто не могу.

В столбце B у меня есть некоторые значения, которые отличаются каждый день, а заголовок столбца B - это дата =Today().

Следующие заголовки столбцов - это дни года ... поэтому мне нужно скопировать значения столбца B, найти столбец, соответствующий дню, а затем вставить значения в этом столбце.

Answer 1

Вот Sub для выполнения этой задачи

Sub Demo()
    Dim ws As Worksheet
    Dim rSrc As Range
    Dim rDst As Range
    Dim cl As Range
    Dim dat As Variant

    Set ws = ActiveSheet

    ' Get the Source range
    Set rSrc = ws.Range([B2], ws.Columns(2).Cells(ws.Rows.Count, 1).End(xlUp))
    dat = rSrc

    ' Find the Destination column and copy data
    Set rDst = ws.Range([C1], ws.Rows(1).Cells(1, ws.Columns.Count).End(xlToLeft))
    Set cl = rDst.Find(What:=[B1], _
      After:=rDst.Cells(1, 1), _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext)
    If cl Is Nothing Then
        MsgBox "Date Column for " & CStr([B2].Value) & " Not Found"
    Else
        Set rDst = cl.Offset(1, 0).Resize(UBound(dat, 1), 1)
        rDst = dat
    End If
End Sub

В этом коде предполагается, что заголовки дня имеют форматированные DateSerial числа (такие же, как результат =Today())
Если это не так, то Find(What:=[B2] может потребоваться изменить.

Как это работает:

1. Установить ссылку на диапазон исходных данных
2. Копировать исходные данные в массив вариантов
3. Поиск даты из ячейки B2 в используемом диапазоне от C1 до конца строки
4. Если не найден, сообщить об ошибке и завершить
5. Установить диапазон назначения
6. Копировать исходные значения в место назначения