在VBA中，如何創建一個代碼來匹配2張紙上的日期並將數據粘貼到該匹配的日期作為值？ 不能為此使用vlookup

Question

所以我在Excel，計算器和結果表上有2張紙。

在計算器表上，單元格A1具有當前日期。 在結果表上，單元格A2：Infinity的日期每天都在增加。

我正在嘗試編寫一個程序，如果計算器表中的單元格A1等於結果表中的單元格A2：Infinity，它將把數據表單元格C2：C7的數據單元格范圍復制粘貼到結果表中的匹配日期，如下所示：轉置值到單元格范圍（B：G）

VLOOKUP無法工作，因為日期更改會導致以前的數據消失。

結果表

計算器表

任何幫助，將不勝感激！

Answer 1

您可以嘗試以下代碼：

Option Explicit

Sub main()
    Dim f As Range, calculatorData As Range
    Dim dateStrng As String

    With Worksheets("Calculator") '<--| reference "Calculator" worksheet
        Set calculatorData = .Range("C2:C7") '<--| set its range with data to be copied
        dateStrng = .Range("A1").value '<-- retrieve the date to be searched
    End With

    With Worksheets("Results") '<--| reference "Results" worksheet
        Set f = .Range("A2", .Range("A2").End(xlDown)).Find(what:=dateStrng, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<-- look for searched data in its column "A" cells from row 2 down to last contiguous non empty cell
    End With

    If Not f Is Nothing Then f.Offset(, 1).Resize(, 6).value = Application.Transpose(calculatorData.value) '<--| if date is found then copy relevant values from "Calculator" next to it
End Sub

---

編輯：

如果excel工作表中的日期不是String值而是實際的Date值，則只需更改：

dateStrng = .Range("A1").value '<-- retrieve the date to be searched

變成：

dateStrng = WorksheetFunction.Text(.Range("A1").value, "[$-409]mmmm,dd-yyyy;@") '<-- retrieve the date to be searched in the proper language (e.g.: 409 = English)

您可以在這里找到所有語言代碼