根据特定年份复制和粘贴列数据

Question

我有一张 Excel 表格，上面有前几年的价格（建筑中使用的材料的价格），我正在尝试制作一个代码，该代码将根据我选择的某一年向我显示所有数据。

这是我的列表/excel 的样子

在单元格 E3（黄色）中，我输入了我希望“分析”的年份，并且在那一年，我需要一个函数来搜索列 K 到 Q（以及更多，因为每年价格都在变化），搜索对于那个特定的年份，如果它与我在单元格 E3 中输入的相同，将复制并粘贴所有销售数据，reg。 地点和规格。 地点进入 F、G 和 H 列。

我不知道是否更容易，而不是将年份放入单元格 K3、L3 和 M3（例如），如果我将其放入单元格 N3、R3 等（红色）中，该函数将采用前 3 列并将它们复制/粘贴到 F 到 H 列中。

这是选项 2，如果它使编码更容易

此外，该列表一直持续到第 381 行，并且最终可能会输入更多数据，因此请考虑到该列表具有无限数量的行。 但是，对于列，它始终固定为 3 列。

仅供参考：这不是一个学校项目，我只是想找到一种方法来简化我的工作，而不是每次都手动搜索和复制/粘贴数据。 希望有解决办法，谢谢！！

Answer 1

请尝试下一个代码。 它应该做你需要的（我理解）。 它应该很快，不使用剪贴板进行复制。 正如我在评论中建议的那样，它首先在年份的第三行搜索/查找（长或字符串，因为它写在 "E3" 中），在 "E3" 之后开始搜索，然后复制根据找到的单元格构建的范围. 如果未找到匹配项，则代码在If rngFirstCol Is Nothing Then Exit Sub行退出。 您可以在此处放置一条消息，以在这种情况下发出警告。 它适用于您的第一个排列/图片，这意味着必须在第一列的第三行填写年份，从那里收集/复制必要的数据：

Sub ExtractPricesPerYear()
  Dim sh As Worksheet, lastR As Long, rngFirstCol As Range, lngYear, necCol As Long
  
  Set sh = ActiveSheet 'use here your necessary sheet
   lngYear = sh.Range("E3").value 'the year to be searched
  Set rngFirstCol = sh.rows(3).Find(What:=lngYear, After:=sh.Range("E3"), LookIn:=xlValues, Lookat:=xlWhole)
  If rngFirstCol Is Nothing Then Exit Sub
  necCol = rngFirstCol.Column
  lastR = sh.cells(sh.rows.count, necCol).End(xlUp).row
  With sh.Range(rngFirstCol.Offset(1), sh.cells(lastR, necCol + 2))
        sh.Range("E4").Resize(.rows.count, .Columns.count).value = .value
  End With
End Sub

请在测试后发送一些反馈。

还有一个问题：向我们展示您自己尝试过的东西很好。 如果不是一段代码，至少，可以证明你调查过并且对要解决的任务有一些想法，寻求提示、建议等，证明你知道如何完成它......

编辑：

按照您上次评论的要求，请使用下一个解决方案。 请复制相应工作表代码模块中的下一个代码（右键单击工作表名称，然后选择View Code ）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim lastR As Long, lastRF As Long, rngFirstCol As Range, lngYear, necCol As Long
  
    If Target.Address(0, 0) = "E3" Then 'the code exits for any other change on the sheet
         lngYear = Target.value 'the year to be searched
        Set rngFirstCol = Me.rows(3).Find(What:=lngYear, After:=Me.Range("E3"), LookIn:=xlValues, Lookat:=xlWhole)
        If rngFirstCol Is Nothing Then MsgBox "No such year found on the third row...:":   Exit Sub
        
        necCol = rngFirstCol.Column 'column number of the found cell
        lastR = Me.cells(Me.rows.count, necCol).End(xlUp).row   'last row on the found column
        lastRF = Me.Range("F" & Me.rows.count).End(xlUp).row  'last row on F:F column (to delete its content, if any)
           If lastRF > 4 Then Me.Range("F4:H" & lastRF).ClearContents 'clear the range to make place for the new data
        With Me.Range(rngFirstCol.Offset(1), Me.cells(lastR, necCol + 2))
              Me.Range("F4").Resize(.rows.count, .Columns.count).value = .value
        End With
    End If
End Sub