将相对于日期（列）的值从工作表复制/粘贴到具有日期列的另一个工作表

2 回答

• 0

  试试这个，您可能需要更改一些值以匹配您的工作簿 .
  就像for循环中的工作表名称和起始行一样 .

  Sub sheetValues()
  
      'collect information in sheet one into an array
      With Sheets("Sheet1")
          'check last filled in cell in column / last date
          Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
          'new array with range information
          sheetOneInfo = .Range(.Cells(1, 1), .Cells(last.Row, 2)).Value
      End With
  
      With Sheets("Sheet2")
          'check last filled in cell in column / last date
          Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
  
          'for each cell in range
          For n = 1 To last.Row
              'if value in sheet two is in array
              If InArray(.Cells(n, 1).Value, sheetOneInfo) > 0 Then
                  'put collected value in appropriate cell
                  .Cells(n, 2).Value = sheetOneInfo(InArray(.Cells(n, 1).Value, sheetOneInfo), 2)
              End If
          Next
      End With
  End Sub
  
  Function InArray(val As String, arr As Variant) As Double
  
      InArray = 0
      'for each value in array
      For n = 1 To UBound(arr)
          'if date in array matches cell date
          If arr(n, 1) = val Then
              'return date position
              InArray = n
              Exit Function
          End If
      Next
  End Function
  

  回复于 2024-04-19T17:31:14+08:00
• 0

  您可以尝试下面的代码 . 您可以根据您拥有的数据数量更改数字100，或者如果更改数据，您可以计算数据 .

  For i = 1 To 100
    For j = 1 To 100
      If Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, 1) Then
        Sheets(2).Cells(j, 2) = Sheets(1).Cells(i, 2)
      End If
    Next j
  Next i
  

  回复于 2024-04-19T17:31:14+08:00