在單元格中查找值並在該單元格的列中粘貼範圍的宏。 EXCEL 2007

-1

我正在嘗試寫一個VBA代碼，它可以自動執行我每天都在做的一個步驟，但我不能。在單元格中查找值並在該單元格的列中粘貼範圍的宏。 EXCEL 2007

在列B我有一些值是不同的每天，並且列B的標題是日期=Today()。

下一個列標題是一年的日子..所以我需要的是複製列B的值，查找與當天匹配的列，然後將值粘貼到該列中。

2012-01-02 user1126959

爲了確保我理解。單元格B1包含今天的日期。今天B1包含2012年1月3日，但三天前它包含2011年12月31日。單元格C1，D1，E1等也包含日期。你需要一個發現單元格X1的例程，使得B1和X1包含相同的日期。然後，您希望將Bn複製到X的每個n值。在此例程運行之前，列X是否爲空？單元格B1，C1等包含Excel日期還是字符串？如果他們是Excel日期，他們是否包含時間？你的問題是你不知道如何編寫這樣的例程或你的例程不工作？ – 2012-01-03 00:21:12

[你試過了什麼？]（http://mattgemmell.com/2008/12/08/what-have-you-tried/） – 2012-01-03 08:49:01

這裏有一個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結束的排
如果找不到報告錯誤並結束
設置目標範圍
將源值複製到目標中

來源

2012-01-03 00:34:35

在單元格中查找值並在該單元格的列中粘貼範圍的宏。 EXCEL 2007

回答

相關問題