在 VBA 中，我如何创建一个匹配 2 张工作表中的日期并将数据作为值粘贴到匹配日期的代码？不能为此使用 vlookup

Posted 2023-04-13

【中文标题】在 VBA 中，我如何创建一个匹配 2 张工作表中的日期并将数据作为值粘贴到匹配日期的代码？不能为此使用 vlookup

【英文标题】：In VBA, how do i create a code where it matches dates from 2 sheets and paste data in to that matched date as values? Can't use vlookup for this

【发布时间】：2016-09-05 23:03:18

【问题描述】：

所以我有两张 Excel、计算器和结果表。

在计算器表上，单元格 A1 具有当前日期。在结果表上，单元格 A2:Infinity 的日期按天递增。

我正在尝试编写一个程序，其中如果计算器表中的单元格 A1 等于结果表中的单元格 A2:Infinity，它将复制粘贴计算器表中的数据单元格范围 C2:C7 到匹配日期结果表作为转置值到单元格范围 (B:G)

VLOOKUP 不起作用，因为以前的数据会因为日期的变化而消失。

Results Sheet

Calculator Sheet

任何帮助将不胜感激！

【问题讨论】：

嗨，托比，请发布您尝试过的代码...

【参考方案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)

你可以找到所有语言代码here

【讨论】：

我尝试了代码，它似乎只将单元格 C2 的值从计算器表粘贴到 B:G 结果表中的所有单元格。我也做了你建议的编辑

抱歉，我错过了将“垂直”范围转置到“水平”范围。查看编辑的代码

像魅力一样工作！谢谢！