求助VBA代码

冰冰189

shiruiqiang 发表于 2024-5-9 19:23
很多数据没有，大致的写法

老师不明白什么意思，如果能联动触发是更好的，当然如果6和7确实麻烦不写6和7也可以，谢谢！

Tina.棠

当日计数的意思是当天日期？然后上班时间和下班时间填什么，是A1单元格填入时候的时间？

冰冰189

Tina.棠 发表于 2024-5-9 19:30
当日计数的意思是当天日期？然后上班时间和下班时间填什么，是A1单元格填入时候的时间？

L列

冰冰189

1、将A单元格的G1T07441，提取到B单元格，提取G1后面的T07441到B单元格.
2、需判断，当提取的字符大于6的时候不显示。
3、将A单元格的G1T07441，提取前2位，G1到C单元格里面。

4、K单元格引用B单元格的值，当B单元格长度等于6个人字符的时候，提取到K单元格来。
5、K单元格显示有字符或者数值的时候，L单元格显示日期

6、当L列显示日期的时候需统计当日的计数，当为奇数（如：1、3、5、7）的时候显示上班时间到M单元格来。
7、当L列显示日期的时候需统计当日的计数，当为偶数的时候（如：2、4、6、8）的时候显示下班时间，到N单元格。

Tina.棠

不确定是不是这样，试试看
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge = 1 Then
        If Not Intersect(Target, Range("a:a")) Is Nothing Then
            
            If Len(Target.Value) <= 8 Then
                Application.EnableEvents = False
                Cells(Target.Row, "B").Value = Mid(Target.Value, 3, Len(Target.Value) - 2)
                Cells(Target.Row, "C").Value = Left(Target.Value, 2)
                Application.EnableEvents = True
                If Len(Target.Value) = 8 Then
                    Cells(Target.Row, "K").Value = Cells(Target.Row, "B").Value
                End If
            End If
            
        ElseIf Not Intersect(Target, Range("K:K")) Is Nothing Then
            If Target.Value = "" Then
                Cells(Target.Row, "L").Value = ""
            Else
                Cells(Target.Row, "L").NumberFormat = "yyyy/m/d"
                Cells(Target.Row, "L").Value = Date
               
            End If
        ElseIf Not Intersect(Target, Range("L:L")) Is Nothing Then
            myId = Cells(Target.Row, "K")
            myTime = 0
            For i = 2 To Target.Row
                If Cells(i, "K").Value = myId Then
                    myTime = myTime + 1
                End If
            Next i
            If myTime Mod 2 Then
                Cells(Target.Row, "M").NumberFormat = "HH:MM:SS"
                Cells(Target.Row, "M").Value = Now
            Else
                Cells(Target.Row, "N").NumberFormat = "HH:MM:SS"
                Cells(Target.Row, "N").Value = Now
            End If
        End If
    End If
End Sub

Tina.棠

直接贴代码发不出来……

冰冰189

Tina.棠 发表于 2024-5-9 20:13
直接贴代码发不出来……

老师能否直接把代码发出来，谢谢！

冰冰189

Tina.棠 发表于 2024-5-9 20:10
不确定是不是这样，试试看
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLa ...

老师太好了是这样的，完全正确，能否在现在的代码里面在加一个判断


2、需判断，当提取的字符大于6，或者小于的时候不显示。

冰冰189

Tina.棠 发表于 2024-5-9 20:10
不确定是不是这样，试试看
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLa ...

需判断，当提取的字符大于6，或者小于5的时候不显示，谢谢！  
增加小于5的判断

冰冰189

Tina.棠 发表于 2024-5-9 20:10
不确定是不是这样，试试看
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLa ...

还有一个小问题