根據特定年份復制和粘貼列數據

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