【VBA】自动写入日期

kimpvp

在A2输入“已下载”，下载日期的B2自动写出今天的日期

在A3输入“已打印”，打印日期的C2自动写出今天的日期

在A4输入“已上交”，上交日期的C2自动写出今天的日期

之前百度的时候是用

Private Sub Worksheet_Change(ByVal TargetAs Range)

来写的。

但是这个有个问题，就是我今天写了10个已下载，想下拉填充，但是会出错，并且不会再自动写日期。清除单元格的时候好像也会出错，各位大佬可以帮我解决一下这个问题吗？

（由于代码不成功，没保存到。。。）

yaozong

[B2] 公式，其余向右（或向左）拖拽公式

=IF(RIGHT($A2,2)=LEFT(B$1,2),TODAY(),"")

yaozong

Sub test()
Dim arr, i&, j&
arr = [a1].CurrentRegion.Value
For i = 2 To UBound(arr)
  s1 = Right(arr(i, 1), 2)
  For j = 2 To UBound(arr, 2)
    s2 = Left(arr(1, j), 2)
    arr(i, j) = IIf(s1 = s2, Date, Empty)
Next j, i
[a1].CurrentRegion = arr
End Sub

kimpvp

yaozong 发表于 2018-4-6 12:33
公式，其余向右（或向左）拖拽公式

=IF(RIGHT($A2,2)=LEFT(B$1,2),TODAY(),"")

其实我不想用公式，据我百度来看是要用迭代运算才能实现我想要的功能。

还有一个问题就是如果按你函数来做，第二天日期就会变化了。

不过谢谢回答啦

kimpvp

yaozong 发表于 2018-4-6 12:44
Sub test()
Dim arr, i&, j&
arr = [a1].CurrentRegion.Value

感谢大佬，我是用按钮来使用你代码了。

请问是这么使用的吗？

yaozong

kimpvp 发表于 2018-4-6 13:44
感谢大佬，我是用按钮来使用你代码了。

请问是这么使用的吗？

编辑事件：（可适用多格复制，下拉填充的输入方式）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    Dim ss$, s$, a&, b&, c&, n&
    ss = Application.Phonetic([B1:D1])
    a = Target.Row
    b = Target.Count
    c = a + b - 1
    For i = a To c
        s = Right(Cells(i, 1).Value, 2)
        If Len(s) Then
            n = Application.Ceiling(InStr(ss, s) / 4, 1)
            Cells(i, 1).Offset(, n) = Date
        End If
    Next
End Sub

kimpvp

yaozong 发表于 2018-4-6 19:52
编辑事件：（可适用多格复制，下拉填充的输入方式）

Private Sub Worksheet_Change(ByVal Target As R ...

非常感谢！这就是我想要的效果，100分！