Excel VBA按鈕可使用日期條件將數據從一個單元格粘貼到另一個單元格

Question

VBA有一些新功能。 我花了整整4天的時間試圖弄清楚這一點，並嘗試使用代碼，終於可以尋求幫助了。

我要執行的操作的要點是使用一個按鈕，單擊該按鈕將獲取已生成的數據，並將其放在單元格L11中。 數據流的方式應該是一個月中的一天。 在L11中輸入數據時，日期會更改每個條目。 因此，當我按下按鈕時，我想讓代碼說-基於L8單元格中的日期（已生成），獲取L11中的數據，並將其剪切並粘貼到該日期的Sheet2和列下。

我建立了以下代碼，將數據從L11移動到工作表2單元格A2，然后將數據添加到工作表2的下一行（如果已有數據），但是為了使我想做的更快，我希望想要讓代碼知道L8中的日期，並在sheet2的列中找到該日期並將其粘貼在該日期下，同時從sheet1刪除復制的數據：

Sub copypastetosheets2()

    For Each cell In Range("L8:L8")
    If cell.Value = "Monday, April 15" Then
        Range("L11:L11").Select
        Selection.Copy
        Sheets("sheet2").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("sheet1").Select
        Range("L11").Select
        Application.CutCopyMode = False
        Sheets("sheet2").Select
        Range("A2").Select
        Selection.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
        Sheets("sheet1").Select
        Range("L11").Select

我還在不同的按鈕上使用了此代碼，該按鈕可以工作並且可以執行我想要的操作，但是它仍然無法識別日期並將其放在其他列中：

Sub copypastetosheets()
Sheets("sheet1").Range("L11").Copy


With Sheets("April 15").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
    Worksheets("sheet1").Range("L11:L20").ClearContents
End With

End Sub

不要介意Sheets（“ April 15”）....我在測試時正在使用它。 這段代碼很好用，但是唯一讓我退縮的是日期的識別。 如果它知道將日期視為更改變量，然后根據該特定日期將來自L11的數據按照該日期粘貼到Sheet1上30或31列中的1列下，那么我現在就可以完成：)

任何幫助或指導，我們將不勝感激。 謝謝。

戴夫

Answer 1

好的，根據您告訴我的內容，這是一個非常基本的方法，對於日期，請使用Month day 。 例如L8 = April 3 。

Sheet2
April 1   April 2   April 3   April 4   April 5   ...
                    Data is
                    copied
                    here

我希望我能正確理解你。 這將在sheet2中找到匹配的日期，將數據復制過來並刪除L8中的數據。

Option Explicit

Dim x As Integer

Sub Button1_Click()

x = 1

'this will find the column that matches the date and stores that as the copy location.
While Sheets("Sheet2").Cells(1, x).Value <> Sheets("Sheet1").Range("L8")
    x = x + 1
Wend


'this portion copies the data to the designated coordinates found by the first portion and delete the information from L8 and L11.
Sheets("Sheet2").Cells(2, x).Value = Sheets("Sheet1").Range("L11").Value
Sheets("Sheet1").Range("L8").Value = ""


End Sub

由於L11中包含公式，因此您不想刪除該單元格。 更改公式為： =IF(L8 <> "", VLOOKUP(K8,A28:B58,2,FALSE), "")

只要L8中沒有數據，此公式將使L11顯得空白。