ребята нужно помощ. на всех eng форумах без результатно.есть макрос но работает он только на 4 цифри как можно переделать макрос что бы он работал на на 8 с черточкой поредене, 0000-0000. извеняюсь за мой русский.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TimeStr As String
On Error GoTo EndMacro If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub End If If Target.Cells.Count > 1 Then Exit Sub End If If Target.Value = "" Then Exit Sub End If
Application.EnableEvents = False With Target If .HasFormula = False Then Select Case Len(.Value) Case 1 ' e.g., 1 = 00:01 AM TimeStr = "00:0" & .Value Case 2 ' e.g., 12 = 00:12 AM TimeStr = "00:" & .Value Case 3 ' e.g., 735 = 7:35 AM TimeStr = Left(.Value, 1) & ":" & _ Right(.Value, 2) Case 4 ' e.g., 1234 = 12:34 TimeStr = Left(.Value, 2) & ":" & _ Right(.Value, 2) Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45 TimeStr = Left(.Value, 1) & ":" & _ Mid(.Value, 2, 2) & ":" & Right(.Value, 2) Case 6 ' e.g., 123456 = 12:34:56 TimeStr = Left(.Value, 2) & ":" & _ Mid(.Value, 3, 2) & ":" & Right(.Value, 2) Case Else Err.Raise 0 End Select .Value = TimeValue(TimeStr) End If End With Application.EnableEvents = True Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub
[/vba]
ребята нужно помощ. на всех eng форумах без результатно.есть макрос но работает он только на 4 цифри как можно переделать макрос что бы он работал на на 8 с черточкой поредене, 0000-0000. извеняюсь за мой русский.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TimeStr As String
On Error GoTo EndMacro If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub End If If Target.Cells.Count > 1 Then Exit Sub End If If Target.Value = "" Then Exit Sub End If
Application.EnableEvents = False With Target If .HasFormula = False Then Select Case Len(.Value) Case 1 ' e.g., 1 = 00:01 AM TimeStr = "00:0" & .Value Case 2 ' e.g., 12 = 00:12 AM TimeStr = "00:" & .Value Case 3 ' e.g., 735 = 7:35 AM TimeStr = Left(.Value, 1) & ":" & _ Right(.Value, 2) Case 4 ' e.g., 1234 = 12:34 TimeStr = Left(.Value, 2) & ":" & _ Right(.Value, 2) Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45 TimeStr = Left(.Value, 1) & ":" & _ Mid(.Value, 2, 2) & ":" & Right(.Value, 2) Case 6 ' e.g., 123456 = 12:34:56 TimeStr = Left(.Value, 2) & ":" & _ Mid(.Value, 3, 2) & ":" & Right(.Value, 2) Case Else Err.Raise 0 End Select .Value = TimeValue(TimeStr) End If End With Application.EnableEvents = True Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TS As String On Error GoTo EndMacro If Len(Target.Value) = 11 Then Exit Sub If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Len(Target.Value) = 9 And InStr(1, Target.Value, "-") = 5 Then TS = Target.Value Target.Value = Mid(TS, 1, 2) & ":" & Mid(TS, 3, 2) & "-" & Mid(TS, 6, 2) & ":" & Mid(TS, 8, 2) End If Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TS As String On Error GoTo EndMacro If Len(Target.Value) = 11 Then Exit Sub If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Len(Target.Value) = 9 And InStr(1, Target.Value, "-") = 5 Then TS = Target.Value Target.Value = Mid(TS, 1, 2) & ":" & Mid(TS, 3, 2) & "-" & Mid(TS, 6, 2) & ":" & Mid(TS, 8, 2) End If Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TS As String On Error GoTo EndMacro If Len(Target.Value) = 11 Then Exit Sub If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Len(Target.Value) = 8 Then TS = Target.Value Target.Value = Mid(TS, 1, 2) & ":" & Mid(TS, 3, 2) & "-" & Mid(TS, 5, 2) & ":" & Mid(TS, 7, 2) End If Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub
[/vba]
без "-" просто 8 цифр. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TS As String On Error GoTo EndMacro If Len(Target.Value) = 11 Then Exit Sub If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Len(Target.Value) = 8 Then TS = Target.Value Target.Value = Mid(TS, 1, 2) & ":" & Mid(TS, 3, 2) & "-" & Mid(TS, 5, 2) & ":" & Mid(TS, 7, 2) End If Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub