Question

我只想将范围的某些值复制到特定行（Excel）。值在范围B2：F2中这些值应该在昨天的行中复制，即使当天是工作日也是如此。如果今天是星期一，则应将值复制到星期五的行。

我在A2：A3500中有日期值，格式为“ dd.mm.yyyy”。这些值应复制到Bx：Fx。

这怎么办？

我已经尝试过，但是不起作用。...

Dim sv, sq, k As Long, zl
With Sheets("tblGeneral")
sv = .Cells(6, 1).CurrentRegion.Resize(, 6)
sq = .Cells(2, 2).Resize(, 5)
zl = Application.Match(CLng(Date), .Columns(1), 0)
  If Not IsError(zl) Then
       For k = 2 To 6
         sv(zl - 7, k) = sq(1, k - 1)
       Next k
     .Cells(6, 1).CurrentRegion.Resize(, 6) = sv
  End If

End With

Answer 1

我认为类似这样的方法对您有用：

Sub tgr()

    Dim ws As Worksheet
    Dim rTarget As Range
    Dim rCopy As Range
    Dim dtCompare As Date
    Dim dtTarget As Date
    Dim sDateFormat As String

    Set ws = ActiveWorkbook.Worksheets("tblGeneral")
    Set rCopy = ws.Range("B2:F2")
    dtCompare = Date
    sDateFormat = ws.Range("A2").NumberFormat

    Select Case Format(dtCompare, "ddd")
        Case "Mon": dtTarget = dtCompare - 3
        Case "Sun": dtTarget = dtCompare - 2
        Case Else:  dtTarget = dtCompare - 1
    End Select

    Set rTarget = ws.Columns("A").Find(Format(dtTarget, sDateFormat), , xlValues, xlWhole)
    If Not rTarget Is Nothing Then
        rTarget.Offset(, 1).Resize(rCopy.Rows.Count, rCopy.Columns.Count).Value = rCopy.Value
    Else
        MsgBox "Target date [" & Format(dtTarget, sDateFormat) & "] not found.", , "Error"
    End If

End Sub

VBA-复制并粘贴上一个工作日

1 个答案: