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]可能需要更改。

工作原理：

设置对源数据范围的引用
将源数据复制到变体数组
从B2到行尾的使用范围内的单元格C1搜索日期
如果未找到则报告错误并结束
设置目的地范围
将源值复制到目标

在单元格中查找值的宏＆amp;然后在该单元格的列中粘贴一个范围。 EXCEL 2007

1 个答案: