将数据复制并粘贴到不同的工作表 - 查找交集

Question

我正在尝试构建一个宏，它基本上将数据从worksheet("sheet2")复制并粘贴到worksheet("sheet3")。

在第2页中，我在A列cells(2,1).End(xlUp).Row中有日期。下面我拍了一下我的数据。

我同时拥有每个领域的美元和欧元价值。使用的最后一列通常是未知的，这将有所不同。

在第3页中，我想要粘贴的数据，我希望宏从sheet2查找日期，如果找到粘贴数据。要查找的日期是 D栏。第2行。

棘手的部分是美元值应该粘贴在 I到K 列中，然后再次粘贴到 L到N 列中。 EUR值应粘贴在 O到Q 列之间。然后在 R到T 列中粘贴到此处的美元值。表3中的列标题与表2相同。

我曾尝试过vlookup，但意识到这不是最有效的方法。

第3页上的结果

只有复制的信息才是值。日期已在表3中。 即如果在表3中找到日期，则金额将填入右栏。不会创建新行。

在美元价值部分

在EUR部分，结果如下：

Answer 1

Option Explicit
Sub CopyIt()
  Dim CheckDate As Date
  Dim FoundRow As Integer
  Dim Range_T0_Search As String

  '** get the date you are looking for from sheet 3 cell D2 ***
  CheckDate = Sheet3.Range("D2").Value

  '****
  Range_T0_Search = "A2:A" & Trim(Str(Sheet2.Cells(2, 1).End(xlDown).Row))
  FoundRow = findIt(Range_T0_Search, CheckDate)


     '*** if it can't find the date on sheet2 then don't copy anything
  If FoundRow = 0 Then Exit Sub

  '*** do the USD bit *****
  Sheet3.Cells(6, 1) = CheckDate '** put the date on sheet 3 ***
  Sheet3.Cells(6, 2) = Sheet2.Cells(FoundRow, 3) '*** copy across usd income ***
  Sheet3.Cells(6, 3) = Sheet2.Cells(FoundRow, 5) '*** copy across usd Expensies ***
  Sheet3.Cells(6, 4) = Sheet2.Cells(FoundRow, 7) '*** copy across usd Tax ***

  '*** Do the Euro bit ****
  Sheet3.Cells(6, 7) = CheckDate '** put the date on sheet 3 ***
  Sheet3.Cells(6, 8) = Sheet2.Cells(FoundRow, 2) '*** copy across usd income ***
  Sheet3.Cells(6, 9) = Sheet2.Cells(FoundRow, 4) '*** copy across usd Expensies ***
  Sheet3.Cells(6, 10) = Sheet2.Cells(FoundRow, 6) '*** copy across usd Tax ***


End Sub

Function findIt(Dates_Range As String, Date_To_Find As Date) As Integer
  Dim C As Variant
  Dim Address As Range

  With Sheet2.Range(Dates_Range)
    Set C = .Find(Date_To_Find, LookIn:=xlValues)
    If Not C Is Nothing Then
        findIt = Range(C.Address).Row
    End If
End With

End Function

以上做了我认为你想要的实际格式和你想要的列。 从第三张单元格D2开始，它需要一个日期。它在A列的工作表2中查找该日期。如果找到它，它将复制数据。首先是一组美元数据然后是欧元。您将不得不更改它以将数据放在您想要的列中，但我希望它能让您走上正确的轨道。

Answer 2

Option Explicit
Sub CopyIt()
  Dim CheckDate As Date
  Dim FoundRow As Integer
  Dim Range_T0_Search As String
  Dim Rownum As Integer

  '*** Go through each date on sheet 3 column A in turn and try to find it on sheet 2 ****
  For Rownum = 2 To Sheet3.Cells(2, 1).End(xlDown).Row

    '** get the date you are looking for from sheet 3 Coumn A ***
    CheckDate = Sheet3.Cells(Rownum, 1).Value

    '**** set the range where you wnat to look for the date containe din checkdate ****
    Range_T0_Search = "A2:A" & Trim(Str(Sheet2.Cells(2, 1).End(xlDown).Row))
    FoundRow = findIt(Range_T0_Search, CheckDate)

    '*** if it can't find the date on sheet2 then don't copy anything
    If FoundRow = 0 Then Exit Sub

    '*** do the USD bit *****

    Sheet3.Cells(Rownum, 2) = Sheet2.Cells(FoundRow, 3) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 3) = Sheet2.Cells(FoundRow, 5) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 4) = Sheet2.Cells(FoundRow, 7) '*** copy across usd Tax ***

    '*** Do the Euro bit ****

    Sheet3.Cells(Rownum, 8) = Sheet2.Cells(FoundRow, 2) '*** copy across usd income ***
    Sheet3.Cells(Rownum, 9) = Sheet2.Cells(FoundRow, 4) '*** copy across usd Expensies ***
    Sheet3.Cells(Rownum, 10) = Sheet2.Cells(FoundRow, 6) '*** copy across usd Tax ***
 Next

End Sub

Function findIt(Dates_Range As String, Date_To_Find As Date) As Integer
  Dim C As Variant
  Dim Address As Range

  With Sheet2.Range(Dates_Range)
    Set C = .Find(Date_To_Find, LookIn:=xlValues)
    If Not C Is Nothing Then
        findIt = Range(C.Address).Row
    End If
End With

End Function