Notifications
Clear all
2024 - VBA & Macros
4
Posts
3
Usuários
0
Reactions
812
Visualizações
Topic starter
Pessoal preciso de um Help.
Tenho o seguinte codigo VBA
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TimeStr As String On Error GoTo EndMacro If Application.Intersect(Target, Range("G8:J5000")) 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 "Digite a hora sem os pontos" Application.EnableEvents = True End Sub
No codigo acima a regra está aplicando somente no intervalo de "G8:J5000", porem, preciso que essa messa regra se aplique nos intervalos "AB8:AC5000" E "BH8:BI5000", como devo proceder?
Att.
Samuel Eloi
Postado : 25/03/2017 1:01 am
Bom dia Samuel
Como você é novato, para facilitar a tua participação no fórum, sugiro tomar conhecimento do conteúdo dos links abaixo:
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371
[]s
Patropi - Moderador
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 25/03/2017 11:27 am
Substitua esta linha
If Application.Intersect(Target, Range("G8:J5000")) Is Nothing Then
por esta
If Application.Intersect(Target, Range("AB8:AC5000, BH8:BI5000")) Is Nothing Then
Osvaldo
Postado : 25/03/2017 5:02 pm
Topic starter
Valeu Brother....
Resolvido.
Postado : 25/03/2017 8:01 pm