vba依据条件自动填入指定样式的数据

SCWYZJ

求助；依据姓名自动填入日期和编号（详见附见），日期一旦录入永久不变。麻烦老师帮忙看看，如何弄。谢谢。小花静候！

kuangben8

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Column <> 2 Or Target.Row < 5 Then Exit Sub
    'If Target.Address Like "*:*" Then Exit Sub
    Dim m%, n%
    Target(1, 3).Value = Format(Now(), "yyyymmdd")
    For m = 5 To Target.Row
        If Left(Cells(m, 4).Value, 6) = Left(Target(1, 3).Value, 6) Then
            n = n + 1
        End If
    Next
    Target(1, 2).Value = Format(Now(), "【yyyy】mm-") & Format(n, "000")
    Application.EnableEvents = True
End Sub

kuangben8

VBA依据条件自动填入指定样式数据.zip (16.52 KB, 下载次数: 10)

2024-8-21 23:18 上传

点击文件名下载附件

SCWYZJ

kuangben8 发表于 2024-8-21 23:19

老师，怎么没效果？

ykcbf1100

工作表事件

ykcbf1100

参与一下。。。

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2.     Application.EnableEvents = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     today = Format(Date, "yyyymmdd")
   
5.     yf = Mid(today, 5, 2)
   
6.     If T.Row > 4 And T.Column = 2 Then
   
7.         r = Me.Cells(Rows.Count, 2).End(3).Row
   
8.         For i = 5 To r
   
9.             s = Left(Me.Cells(i, 4), 6)
   
10.             d(s) = d(s) + 1
    
11.         Next
    
12.         Me.Cells(T.Row, 4) = today
    
13.         s = Left(today, 6)
    
14.         d(s) = d(s) + 1
    
15.         Me.Cells(T.Row, 3) = "【" & Left(today, 4) & "】" & yf & "-" & Format(d(s), "000")
    
16.     End If
    
17.     Application.EnableEvents = True
    
18. End Sub
    

复制代码

liulang0808

SCWYZJ 发表于 2024-8-22 06:52
老师，怎么没效果？

有可能是屏蔽事件属性了吧？
sub aaa
Application.EnableEvents = True
end sub

运行这段代码以后，再看看是否可行吧

kuangben8

SCWYZJ 发表于 2024-8-22 06:52
老师，怎么没效果？

下载我的附件呢？也不好使吗？

quqiyuan

参与一下，仅供参考。。。

SCWYZJ

老师你们的代码都不错，但是我的要求是，保存后日期不变，序号可接着递增，不受事件影响。