CONHEÇA o BABOO PRO e a Comunidade BABOO que substituirão o site BABOO e esse fórum

Ir para conteúdo
  • Cadastre-se
Kayo Anthony

Duas formulas juntas worksheet.change

Mensagem Recomendada

Oi gente, como sabemos o vba nao aceita na mesma planilha dois worksheets juntos. so que eu preciso deles juntos. ele da erro de compilacao por ter nome repetido. alguém me ajuda a unir os dois?

Private Sub Worksheet_Change(ByVal Alvo As Range)
     Dim limite_maximo As Integer
  limite_maximo = 1000 ' altere aqui para limitar a última linha
  If Alvo.Cells.Count > 1 And IsEmpty(Alvo) Then Exit Sub
    ' faz nada se mais de uma célula modificada ou se deu delete
  If Alvo.Column = 3 And Alvo.Row >= 1 And Alvo.Row <= limite_maximo Then
    ' o if acima garante que a célula modificada está dentro a2:a100
    ' desliga captura do evento change
  Application.EnableEvents = False
    ' muda a célula C da linha correspondente
  Alvo.Offset(0, 4).Value = Date    'Troque por Date() se quiser que mostre a data ao invés do horário
    ' religa a captura de eventos
  Application.EnableEvents = True
 
End Sub
Private Sub Worksheet_Change (ByVal Target As Range)


If Target.Column = 4 Then
Target.Offset(0, 4) = Target.Offset(0, 4) + Target.Value

Target.Offset(0, 0).Select


On Error Resume Next  'trata um eventual erro, tipo deletar
 
 
   Target.Offset(0, 0).Select
End If


End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Kayo.

Veja se o código abaixo atende. Se não atender, sugiro que você explique com exatidão o que você deseja que o código faça e em que condições.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 4 Then
  Target.Offset(0, 4).Value = Target.Offset(0, 4).Value + Target.Value
 ElseIf Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
  Target.Offset(0, 4).Value = Date
 End If
End Sub

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ola amigo, é porque sao dois codigos. um é para toda vez que a celula for alterada ele mostrar a data de alteracao, e a outra é quando outra celula for alterada ele ir somando os valores a medida que vou alterando a mesma celula autmaticamente. mas a questao é que ambas sao worksheet_change e ai acaba que so uma funciona e nao as duas. no caso aqui ta desorganizado porque dando certo eu so faco pegar o codigo e colar na planilha mesmo. segue em anexo o modelo com o codigo que falei. Mas no caso seria assim, quando a coluna D for inserido valor é pra ir somando na H. e na coluna C quando for altgerada é pra aparecer a data na coluna G.

por gentileza nao apagar(teste2).xls

Editado por Kayo Anthony

tinha alguns erros.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, amigo.

Experimente o código abaixo no lugar do anterior.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 4 Then
  Target.Offset(0, 4).Value = Target.Offset(0, 4).Value + Target.Value
 ElseIf Target.Column = 3 Then
  Target.Offset(0, 4).Value = Date
 End If
End Sub

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Oi voltei aqui, porque esse código ta conflitando com o botão de limpar os dados. e agora? kk

taqui o codigo do botao

 

Sub fncCLEARVENDAS()
  Dim wks As Excel.Worksheet
 
  For Each wks In Sheets
    Select Case wks.Name
      Case "MAT.", "FOR.", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120"
        wks.Range("D3:D203").ClearContents
    End Select
  Next wks
End Sub

 

ta dando erro de depuracao 13 tipos incompativeis .

untitled.JPG

Editado por Kayo Anthony

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ola pessoa. Tenho a mesma dificuldade. Podem me ajudar? NO meu caso são duas rotinas na mesma planilha. Dá para juntar?

 

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:D")) Is Nothing Then
        Range("A24").Sort Key1:=Range("A25"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
End Sub

 

E essa


Private Sub Worksheet1_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("A:D")) Is Nothing Then
        Range("A56").Sort Key1:=Range("A57"), _
          Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

Alguém pode me ajudar a juntar esses dois Worksheets? Testei em duas planilhas diferentes e eles funcionam, porém não consigo juntá-los! 

Sou iniciante e aprendendo agora VBA. 

 

Private Sub Worksheet_Change(ByVal Target As Range)
        Application.EnableEvents = False
        If Not Intersect(Target, Range("B4")) Is Nothing Then
           Select Case Target
             Case 1
               Call macro1
             Case 2
               Call Macro2
             Case 3
               Call Macro3
             Case 4
               Call Macro4
             Case 5
               Call macro5
             Case 6
               Call Macro6
             Case 7
               Call Macro7
             Case 8
               Call Macro8
             Case 9
               Call Macro9
             Case Else
           End Select
        End If
        Application.EnableEvents = True
        
End Sub

 

e este..

 

Private Sub Worksheet_Change(ByVal Alvo As Range)
    Dim limite_maximo As Integer
    limite_maximo = 800 ' altere aqui para limitar a última linha
    ' faz nada se mais de uma célula modificada ou se deu delete
    If Alvo.Cells.Count > 1 Or IsEmpty(Alvo) Then Exit Sub
      
    If Alvo.Column = 5 And Alvo.Row >= 4 And Alvo.Row <= limite_maximo Then
       ' o if acima garante que a célula modificada está dentro a2:a100
       '
       ' desliga captura do evento change
       Application.EnableEvents = False
       ' muda a célula C da linha correspondente
       Alvo.Offset(0, 3).Value = Str(Now)
       
       Application.EnableEvents = True
    End If
      
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Experimente:


Private Sub Worksheet_Change(ByVal Target As Range)
 Dim limite_maximo As Integer
  limite_maximo = 800 ' altere aqui para limitar a última linha
 
' faz nada se mais de uma célula modificada ou se deu delete
  If Target.Count > 1 Then Exit Sub
  If IsEmpty(Target.Value) Then Exit Sub
 
 If Target.Column = 5 And Target.Row >= 4 And Target.Row <= limite_maximo Then
 
' o if acima garante que a célula modificada está dentro a2:a100 ~~~> o correto é E4:E800
  ' muda a célula C da linha correspondente
  Target.Offset(0, 3).Value = Now
 
 ElseIf Target.Address = "$B$4" Then
  Select Case Target.Value
   Case 1: Macro1
   Case 2: Macro2
   Case 3: Macro3
   Case 4: Macro4
   Case 5: Macro5
   Case 6: Macro6
   Case 7: Macro7
   Case 8: Macro8
   Case 9: Macro9
 End Select

 End If
      
End Sub

 

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

MUITOOOO obrigada! Perfeito. 

Agora.....eu consigo concatenar essa função, dizendo que caso eu digite 50, além data, deve aparecer "estuda fora" e caso digite 100, aparece além da data, "mudou-se"?

Tentei usando

=SE(E23=$G$3;CONCATENAR($G$2;": ";datafixa);SE(E23=$F$3;CONCATENAR($F$2;": ";datafixa;))) 

mas a função datafixa que criei muda automaticamente toda vez que abro a planilha, quero que fique a data de quando eu alterar a coluna e, para 50 ou 100.... 

considerar

f2="estuda fora"

f3=50 

g2="mudou-se" 

g3=100

 

Mando a planilha em anexo caso ajude a me fazer compreender! 

BUSCA ATIVA COM MACROS OK.xlsm

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Quer postar a sua dúvida? Cadastre-se pois é rápido e fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar Agora

×
×
  • Criar Novo...