Notifications
Clear all

Ajuda com worksheet change

7 Posts
2 Usuários
0 Reactions
1,529 Visualizações
(@paulo_001)
Posts: 149
Estimable Member
Topic starter
 

Boa noite a todos.
Tenho uma dúvida quanto a esse código:
_________________________________________________________________________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    If Target.Column = 4 Then
        With Target
            If Cells(.Row, .Column) <> "" Then
                Cells(.Row, 1) = VBA.Format(Date, "Ddd")
                Cells(.Row, 2) = VBA.Format(Date, "mm/dd/yy")
                Cells(.Row, 7) = VBA.Format(Time, "hh:mm:ss")
                Cells(.Row, 11) = "Presente"
            End If
         End With
            
      If Target.Column = 4 Then
         With Target
            If Cells(.Row, .Column) = "" Then
             Cells(.Row, 1) = ""
             Cells(.Row, 2) = ""
             Cells(.Row, 3) = ""
             Cells(.Row, 5) = ""
             Cells(.Row, 6) = ""
             Cells(.Row, 7) = ""
             Cells(.Row, 8) = ""
             Cells(.Row, 9) = ""
             Cells(.Row, 10) = ""
             Cells(.Row, 11) = ""
             
            End If
          End With
                          
    [color=#FF4000]If Target.Column = 8 Then
         With Target
            If Cells(.Row, .Column) <> "" Then
             Cells(.Row, 11) = ""
             
         End If
        End With[/color]
        
      End If
        
        End If
      End If
    End Sub

A parte em vermelho não funciona (na verdade eu nem sei se está certo). A ideia seria se toda vez que a célula da coluna 8 for preenchida o conteúdo da 11ª coluna se apague.

Eu acho que dá erro pq no começo do código está que se a célula da coluna 4 <> "" a coluna 11 será preenchida com "Presente".
Não sei como proceder.

 
Postado : 30/04/2013 4:25 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!

Eu acho que eu não entendi, mas veja se é isso.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H2:N1000")) Is Nothing Then
        If UCase(Trim(Target)) <> "" Then
            Set rng = Range("K" & Target.Row)
            Application.EnableEvents = False
            rng.ClearContents
            Application.EnableEvents = True
        End If
    End If
End Sub

Att

 
Postado : 30/04/2013 4:34 pm
(@paulo_001)
Posts: 149
Estimable Member
Topic starter
 

Muito bom Alexandre :D

Porém não é isso, do código que eu coloquei tudo funciona só aquela parte que estava em vermelho que não.
Estou tentando fazer que ao preencher a célula H30 por exemplo, o conteúdo da K30 se apague.
Isso pode ser facilmente resolvido com a função SE, mas me parece que funções como ela atrapalham o processo automático da planilha.
Vou anexa-la para dar uma olhada

 
Postado : 30/04/2013 4:56 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Monte um modelo bem exemplificado (compactado), e nos mande.

Att

 
Postado : 30/04/2013 5:04 pm
(@paulo_001)
Posts: 149
Estimable Member
Topic starter
 

A explicação está na guia Controle
;)

 
Postado : 30/04/2013 5:18 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Veja se assim atende

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Column = 4 Then
        With Target
            If Cells(.Row, .Column) <> "" Then
                Cells(.Row, 1) = VBA.Format(Date, "Ddd")
                Cells(.Row, 2) = VBA.Format(Date, "mm/dd/yy")
                Cells(.Row, 7) = VBA.Format(Time, "hh:mm:ss")
                Cells(.Row, 11) = "Presente"
            ElseIf Cells(.Row, .Column) = "" Then
                Cells(.Row, 1) = ""
                Cells(.Row, 2) = ""
                Cells(.Row, 3) = ""
                Cells(.Row, 5) = ""
                Cells(.Row, 6) = ""
                Cells(.Row, 7) = ""
                Cells(.Row, 8) = ""
                Cells(.Row, 9) = ""
                Cells(.Row, 10) = ""
            End If
          End With
    ElseIf Target.Column = 8 Then
        With Target
            If Cells(.Row, .Column) <> "" Then
                Cells(.Row, 11) = ""
            End If
        End With
    End If
End Sub

ou assim:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Select Case Target.Column
    Case 4
        With Target
            If Cells(.Row, .Column) <> "" Then
                Cells(.Row, 1) = VBA.Format(Date, "Ddd")
                Cells(.Row, 2) = VBA.Format(Date, "mm/dd/yy")
                Cells(.Row, 7) = VBA.Format(Time, "hh:mm:ss")
                Cells(.Row, 11) = "Presente"
            ElseIf Cells(.Row, .Column) = "" Then
                Cells(.Row, 1) = ""
                Cells(.Row, 2) = ""
                Cells(.Row, 3) = ""
                Cells(.Row, 5) = ""
                Cells(.Row, 6) = ""
                Cells(.Row, 7) = ""
                Cells(.Row, 8) = ""
                Cells(.Row, 9) = ""
                Cells(.Row, 10) = ""
            End If
          End With
    Case 8
        With Target
            If Cells(.Row, .Column) <> "" Then
                Cells(.Row, 11) = ""
            End If
        End With
    End Select
End Sub
 
Postado : 01/05/2013 4:29 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Eu achoque eu inda não entendi, mas tente assim..

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
     
    If Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(, 3) = IIf(Trim(Target) = "", "Presente", "")
        Application.EnableEvents = True
    End If
End Sub
 
Postado : 01/05/2013 5:35 am