查找參考並將所有匹配答案複製到特定列

我已經制作了一個日曆，並且每年都會使用日期來註冊新對象。月份本身並不重要 - 我只是使用月份作爲參考來查找正確的日期範圍，因此目前看起來如此。查找參考並將所有匹配答案複製到特定列

FEB 01/02/2014 
FEB 02/02/2014 
FEB 03/02/2014 
FEB 04/02/2014 
FEB 05/02/2014 
MAR 01/03/2014 
MAR 02/03/2014 
JUN 02/06/2014 
Jun 03/06/2014

全年到位。我在第一頁上有一個詳細介紹月份的下拉菜單，我想要一個使用選定的月份作爲參考的宏，然後將與該月相關的所有日期複製到單獨的列。

任何想法？

來源

2013-11-14 user2993359

這兩個單獨的列嗎？換句話說 - 「FEB」是一列，「01/02/2014」是另一列？你有什麼問題：找到'FEB'值，找到相應的日期，複製它們，或粘貼它們？你有沒有試圖記錄一個宏讓你開始？這通常是一個很好的方法來獲得一個粗略的想法... – Floris

是的，他們是兩個單獨的列，基本上我想選擇和複製具有相同參考的所有日期。我正在嘗試使用過濾器並記錄它，但我不確定在更改日期時它會保持通用 – user2993359

下面的代碼應該是關閉的 - 根據需要進行調整。這不是爲了提高效率而寫的 - 除非你有數千個要複製的項目，否則這將需要「毫無時間」。這個技巧會在更新過程中阻止屏幕閃爍（並使其更快）。

Option Compare Text 

Sub moveStuff() 
Dim rLabel As Range 
Dim rLabelSource As Range 

Dim rDestination As Range 
Dim c, L 

' first label: 
Set rLabel = ActiveWorkbook.Worksheets("source").Range("A2") 
' extend all the way down: 
Set rLabel = Range(rLabel, rLabel.End(xlDown)) 

Set rLabelSource = ActiveWorkbook.Worksheets("destination").Range("A1") 
Set rLabelSource = Range(rLabelSource, rLabelSource.End(xlToRight)) 

Application.ScreenUpdating = false 

' labels in the top row: 
For Each L In rLabelSource.Cells 
' write results in the next row down: 
    Set rDestination = L.Offset(1, 0) 
    For Each c In rLabel.Cells 
    If c.Value = L.Value Then 
     rDestination.Value = c.Offset(0, 1).Value 
     Set rDestination = rDestination.Offset(1, 0) 
    End If 
    Next c 
Next L 

Application.ScreenUpdating = true 

End Sub

在這種情況下，日期和標籤是在被稱爲「源」在片材：

enter image description here

和目的地片（與頂行中的標記，並複製日期出現在它們下面）在片被稱爲「目標」：

enter image description here

顯然，有許多方法可以使這種清潔劑（例如，在複製之前清除destination中標籤下的所有空間，因此不會留下舊值）。而在「真實」的代碼中，你會添加錯誤處理等。

這應該讓你去。

來源

2013-11-14 19:35:45 Floris

查找參考並將所有匹配答案複製到特定列

回答

相關問題