在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)

您可以在这里找到所有语言代码