找到单元格值后查找列“标题”并将标题名称传递给另一个工作表

Question

希望在这里得到一些帮助。 我有一张包含一些示例数据的表格，如下面的模拟表所示。在代码中，我正在查找每个日期在工作表中定义的一组列中出现的位置，如果找到该值，它将整行复制到另一张工作表中。

在这种情况下，如果我查找 2020 年 5 月 31 日，它将复制第 2 行。第 1 行是“标题”。我想看看，当它找到值时，我是否可以找到列标题的值并将其复制到另一张纸上。因此，如果我们要找到 2020 年 5 月 31 日，我想将本例中的标题“3A”复制并粘贴到另一张纸上。

提前致谢！

所以在最后一条评论之后，我可以使用帮助列来挑选我需要的内容。我正在寻找列标题以最终出现在“B”列中。该公式将 A:A 作为搜索值，然后搜索 D2:L2 以查找匹配项。一旦找到该日期匹配，它将返回列标题 I1:L1。从那里我可以将该列复制到另一张纸上。希望这可能会更容易。

Result

Item    |Order |Condition | ID |  RevisionDate| StartDate |1A        |  2A  | 3A
--------|------|----------|----|--------------|-----------|----------|------|-----------
WIdget1 |123   |111       | 1  |  1/1/2020    | 5/1/2020  | 5/4/2020 |  N/A | 5/31/2020
Widget1 |456   |222       | 1  |  2/2/2020    | 5/20/2020 | N/A      |  N/A | 5/5/2020

---

 Sub ResultsRange()
    Dim c As Range
    Dim j As Integer
    Dim NoRows As Long
    Dim wb As Workbook
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Target1 As Worksheet
    Dim Condition As Worksheet
    Dim DestNoRows As Long
    Dim Column As String


    Set wb = Excel.Workbooks("Main.xls")
    Set Source = wb.Worksheets("Stability")
    Set Target = ActiveWorkbook.Worksheets("Results")
    Set Target1 = ActiveWorkbook.Worksheets("Organized")
    Set Condition = ActiveWorkbook.Worksheets("Conditions")

    'Target.UsedRange.Clear
    'Target1.UsedRange.Clear

    NoRows = Source.Range("A500").End(xlUp).Row
    DestNoRows = 2
For I = 1 To NoRows
    Source.Range("1:1").Copy Target.Range("1:1")

   j = 1

' ------------------Relevant code to copy/paste results 
    For Each d In Condition.Range("A2:A32")
      For Each c In Source.Range("I" & I & ":Y" & I)
          If d = c Then
          If d <> "" Then

           c.EntireRow.Copy Target.Range("A" & DestNoRows)
           Target1.Range("G" & DestNoRows).Value = c.Value


          DestNoRows = DestNoRows + 1
          Exit For
 '------------End of Relevant Code-----------------                                      
              j = j + 1
            End If
            End If
        Next c
      Next d
      Next I
      Target.Columns("A:AZ").Font.Name = "Calibri"
      Target.Columns("A:AZ").AutoFit
      'Call CopyColumns
End Sub

Answer 1

能够通过额外的操作来解决