Question

我想编写一个程序，将数据从一个工作簿复制并粘贴到另一个工作簿，这取决于＆＃39;标签＆＃39;在两个范围内。

基本上我想循环遍历一个范围，复制每个单元格旁边的数据，然后根据第二个范围内的相应单元格值将其粘贴到其他位置。我可以用一堆IF语句做到这一点，但是如果有人可以建议使用变量或数组的更有效的选项，那将是非常值得赞赏的，因为对于大型数据集来说显然变得乏味。

谢谢。

For Each ColourCell In CopyRange

    If ColourCell.Value = "Blue" Then
    ColourCell.Offset(, 1).Copy
    PasteRange.Find("Aqua").Offset(, 1).PasteSpecial xlPasteValues
    Else
    End If

    If ColourCell.Value = "Red" Then
    ColourCell.Offset(, 1).Copy
    PasteRange.Find("Pink").Offset(, 1).PasteSpecial xlPasteValues
    Else
    End If

    If ColourCell.Value = "Yellow" Then
    ColourCell.Offset(, 1).Copy
    PasteRange.Find("Orange").Offset(, 1).PasteSpecial xlPasteValues
    Else
    End If

Next

Answer 1

也许这样的事情？（未测试）

Sub Sample()
    '
    '~~> Rest of your code
    '
    For Each ColourCell In CopyRange
        If ColourCell.Value = "Blue" Then copyAndPaste ColourCell, "Aqua"
        If ColourCell.Value = "Red" Then copyAndPaste ColourCell, "Pink"
        If ColourCell.Value = "Yellow" Then copyAndPaste ColourCell, "Orange"
    Next
    '
    '~~> Rest of your code
    '
End Sub

Sub copyAndPaste(rng As Range, strSearch As String)
    Dim PasteRange As Range
    Dim aCell As Range

    '~~> Change this to the releavnt range
    Set PasteRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A10")

    '~~> Try and find the Aqua, Pink, orange or whatever
    Set aCell = PasteRange.Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    '~~> If found
    If Not aCell Is Nothing Then
        rng.Offset(, 1).Copy
        aCell.Offset(, 1).PasteSpecial xlPasteValues
    End If
End Sub

每当您使用.Find时，请检查是否找到了单元格，否则您将收到错误。

Answer 2

我的建议：

= link_to "Collaborate with #{@user.name}", loans_path, class: "button"

复制粘贴取决于两个范围中的单元格值

2 个答案: