如何使用 VBA 將基於某些條件的粘貼數據從一個工作簿復制到另一個工作簿（特定單元格）？

Question

我在下面編寫了用於將數據從一個工作簿復制到另一個工作簿中的特定單元格的代碼（我認為這是挑戰，目標文件下面有月份和相關數據，每個月我都需要將數據復制到當前月份列，這就是為什么使用“最后一列”function 不覆蓋歷史月份也使其動態到 go 到沒有當前月份數據的最后一列）。 即使代碼運行良好，我還是想對其進行優化，以便輕松調試並避免將來出現問題； 當前年份已更改。 您有什么想法可以讓這段代碼更好嗎？

代碼

Dim  x, LastRow, LastColumn, workfile, sourcefile As String
 
 sourcefile = ActiveWorkbook.Name
 workfile = ThisWorkbook.Name


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else

End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
    Else
    End If
    
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
    Else
    End If
    Next

Answer 1

您需要做的就是確定每個條件的目標行是什么，然后將該值插入您要執行的代碼塊中。 這樣你就可以避免多次重復相同的代碼。

以下是您將如何做到這一點：

Dim  x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer

sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1

    ' store the values you are wanting to examine in these 2 variables
    exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case exchangedownload2
        Case Is "GBP"
            If exchangedownload1 = "001B" Then
                targetRow = 28
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 29
        Case Is "EUR"
            If exchangedownload1 = "001B" Then
                targetRow = 35
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 36
    End Select

    ' this is your code block that was being repeated with just a 
    ' different value for your targetRow, so just plug the value for 
    ' targetRow where it belongs and you only have to have this code block once
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues

Next

Answer 2

所以這是“工作文件”的屏幕截圖，我需要每月在相關月份列下復制數據。 影響變化率區域只是公式和計算。 所以復制是在那之前：目前從八月開始的空列，因為我已經在七月運行了它，正如我所說的那樣它有效但代碼似乎太復雜並且難以為另一個人調試

Answer 3

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
    ' store the values you are wanting to examine in these 2 variables
    xrate1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    xrate2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case xrate2
        Case "GBP"
    Select Case xrate1
        Case "001B": targetrow = 28
    Case Else: targetrow = 29
    End Select
    Select Case xrate2
        Case "EUR"
    Select Case xrate1
        Case "001B": targetrow = 35
     Case Else: targetrow = 36
    End Select

    ' copying data
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues
Next

上面是調整后的，因為我不能將 If 語句與 Case 一起使用，Case 是 If、Elseif 的替代品。 但仍然收到編譯錯誤，說它是“Next without For”和 End Select without Case statement((