Fatal编程技术网
  • vba/
  • Vba 将昨天的日期添加到单元格中

Vba 将昨天的日期添加到单元格中

vba excel

Vba 将昨天的日期添加到单元格中,vba,excel,Vba,Excel,我有一份每隔一天更新一次的报告。我想写一个公式，更新第一行，其中有日期，所以它更新的日期，直到昨天的日期 这是我到目前为止写的代码： Sub Update_Newest_Day_Conversions() Worksheets("CPC - Conversions DoD").Range("A1").End(xlToRight).Select MyDate = Date While ActiveCell.Value < MyDate Activ

我有一份每隔一天更新一次的报告。我想写一个公式，更新第一行，其中有日期，所以它更新的日期，直到昨天的日期

这是我到目前为止写的代码：

Sub Update_Newest_Day_Conversions()

    Worksheets("CPC - Conversions DoD").Range("A1").End(xlToRight).Select

    MyDate = Date

    While ActiveCell.Value < MyDate
        ActiveCell.Copy ActiveCell.Offset(0, 1)
        ActiveCell.Offset(0, 1).Select
    Wend

End Sub
不幸的是，我不知道如何添加每个新列的日期都更新为1的部分。这就是它如何结束循环的原因，循环没有明显停止，因为日期保持不变：

有人能帮忙吗

实际上我自己也有，如果有人感兴趣，下面是代码：

Sub Update_Newest_Day_Conversions()

Worksheets("CPC - Conversions DoD").Range("A1"). _
End(xlToRight).Select

MyDate = Date - 1

While ActiveCell.Value < MyDate

ActiveCell.Copy ActiveCell.Offset(0, 1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Value + 1

Wend

End Sub
问题是您总是复制相同的日期，因此该日期总是小于当前日期。您可以尝试以下方法：

While ActiveCell.Value < MyDate
    olddate = ActiveCell.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = olddate + 1
Wend
不建议使用ActiveCell，如果您感兴趣，请查看以下内容：

尝试以下内容：

Sub UpdateNewestDayConversions()

    Dim selectedRange   As Range
    Dim MyDate          As Date
    Dim myCell          As Range

    With Worksheets("CPC - Conversions DoD")
        Set selectedRange = .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))
    End With        

    MyDate = Date - 1

    For Each myCell In selectedRange
        If IsDate(myCell) Then
            If DateSerial(Year(myCell), Month(myCell), Day(myCell)) < MyDate Then
                myCell = DateAdd("d", 1, myCell)
            End If
        Else
            MsgBox "Check " & myCell.Address & " , it is not a valid date!"
        End If
    Next myCell

End Sub

Sub Update_Newest_Day_Conversions()
    Dim col As Integer

    col = Range("A1").End(xlToRight).Column

    While Cells(1, col) < VBA.Date() - 1
        Cells(1, col).Offset(0, 1) = Cells(1, col) + 1
        col = col + 1
    Wend
End Sub
此代码的优点是什么：

它不使用Select； 循环遍历第一行中的所有单元格； 检查单元格是否为有效日期，并告知是否为无效日期； 演示如何使用DateAdd，这是一个很好的函数； 只比较单元格的日期，而不是小时和秒，使用DateSerial查看@Rafalon的注释； 试试这个：

Sub UpdateNewestDayConversions()

    Dim selectedRange   As Range
    Dim MyDate          As Date
    Dim myCell          As Range

    With Worksheets("CPC - Conversions DoD")
        Set selectedRange = .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))
    End With        

    MyDate = Date - 1

    For Each myCell In selectedRange
        If IsDate(myCell) Then
            If DateSerial(Year(myCell), Month(myCell), Day(myCell)) < MyDate Then
                myCell = DateAdd("d", 1, myCell)
            End If
        Else
            MsgBox "Check " & myCell.Address & " , it is not a valid date!"
        End If
    Next myCell

End Sub

Sub Update_Newest_Day_Conversions()
    Dim col As Integer

    col = Range("A1").End(xlToRight).Column

    While Cells(1, col) < VBA.Date() - 1
        Cells(1, col).Offset(0, 1) = Cells(1, col) + 1
        col = col + 1
    Wend
End Sub
试试这个

  Sub Update_Newest_Day_Conversions()

   Worksheets("CPC - Conversions DoD").Range("A1").End(xlToRight).Select
   Diff_Date = Date - ActiveCell.Value

   For i = 1 To Diff_Date - 1
       ActiveCell.Offset(0, 1).Value = ActiveCell.Value + 1
       ActiveCell.Offset(0, 1).Select
   Next

  End Sub
我怀疑Date将返回当前日期和时间，[02/14/2018 00:00]正好低于[02/14/2018 11:17]，因此我想将其更新到昨天的日期。因此，ActiveCell.Value