Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Botão lança valor a...
 
Notifications
Clear all

Botão lança valor ao mesmo tempo

 
2024 - VBA & Macros
Post Recente por rafnakb 8 anos atrás
13 Posts
3 Usuários
0 Reactions
2,728 Visualizações
RSS
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Bom dia. Gostaria que me ajudassem a finalizar o código.
Através do userform do excel em anexo, busco o correspondente código do TxtBox1 na coluna A, e lanço valores nas colunas B, C, D correspondente através do botão salvar. Outro botão dá o comando para lançar os mesmo valores na Plan2 apenas para manter um registro.

Gostaria de um comando num só único botão. Ao clicar, procura e lança na planilha 1 e joga na planliha 2 ao mesmo tempo.

Poderiam ajudar eu terminar com os erros de compilação?

 
Postado : 29/07/2016 6:14 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim:

Private Sub Salvar_Click()
Dim L As Long
Dim iRow As Long
Dim wS As Worksheet
Set wS = Sheets("Plan2")
'Lançar na Plan1
rang = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
For L = 1 To UBound(rang, 1)
    If rang(L, 1) = TextBox1.Value Then
        Cells(L, 2).Value2 = Cells(L, 2).Value2 + TextBox2.Value
        Cells(L, 3).Value2 = Cells(L, 3).Value2 + TextBox3.Value
        Cells(L, 4).Value2 = Cells(L, 4).Value2 + TextBox3.Value
        Cells(L, 5).Value2 = Cells(L, 5).Value2 + TextBox3.Value
    Exit For
    End If
Next

'determina ultima linha da plan2 sem dados e acrescenta 1
iRow = wS.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

'Carregar os dados digitados nas caixas de texto para a planilha
wS.Cells(iRow, 1).Value = Me.TextBox1.Value
wS.Cells(iRow, 2).Value = Me.TextBox2.Value
wS.Cells(iRow, 3).Value = Me.TextBox3.Value
wS.Cells(iRow, 4).Value = Me.TextBox4.Value
wS.Cells(iRow, 5).Value = Me.TextBox5.Value

'Limpar as caixas de texto

txtmodelo.Value = Empty
txttotal.Value = 0
txtdeffund.Value = 0
txtdefus.Value = 0
txtdeff.Value = 0


    MsgBox "Registrado!"

'Colocar o foco na primeira caixa de texto
TextBox1.SetFocus
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/07/2016 6:55 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Obrigado, Reinaldo.
Sim. Está lançando na planilha2, porém o comando não está executando na planilha1 ao mesmo tempo...
Nessa parte:

'Lançar na Plan1
rang = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
For L = 1 To UBound(rang, 1)
    If rang(L, 1) = TextBox1.Value Then
        Cells(L, 2).Value2 = Cells(L, 2).Value2 + TextBox2.Value
        Cells(L, 3).Value2 = Cells(L, 3).Value2 + TextBox3.Value
        Cells(L, 4).Value2 = Cells(L, 4).Value2 + TextBox3.Value
        Cells(L, 5).Value2 = Cells(L, 5).Value2 + TextBox3.Value
    Exit For
    End If

Procura na coluna A, ao achar soma com o valor existente B, C, D, E e então é gravado na planilha 2. Porém, se não achar, nada acontece... "Não Encontrado".
Pode me ajudar com isso ?

 
Postado : 29/07/2016 7:29 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Troque por esta :

Private Sub Salvar_Click()
    Dim L As Long
    Dim iRow As Long
    Dim sCodigo As String
    
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Plan1")
    Set wS_2 = Sheets("Plan2")
    
    'Lançar na Plan1
    rang = wS_1.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
    
    sCodigo = TextBox1.Value
    
    For L = 1 To UBound(rang, 1)
        
        If rang(L, 1) = sCodigo Then
            wS_1.Cells(L, 2).Value2 = Cells(L, 2).Value2 + TextBox2.Value
            wS_1.Cells(L, 3).Value2 = Cells(L, 3).Value2 + TextBox3.Value
            wS_1.Cells(L, 4).Value2 = Cells(L, 4).Value2 + TextBox3.Value
            wS_1.Cells(L, 5).Value2 = Cells(L, 5).Value2 + TextBox3.Value
            
            Exit For
            
        End If
        
    Next

    'determina ultima linha da plan2 sem dados e acrescenta 1
    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

    'Carregar os dados digitados nas caixas de texto para a planilha
    wS_2.Cells(iRow, 1).Value = Me.TextBox1.Value
    wS_2.Cells(iRow, 2).Value = Me.TextBox2.Value
    wS_2.Cells(iRow, 3).Value = Me.TextBox3.Value
    wS_2.Cells(iRow, 4).Value = Me.TextBox4.Value
    wS_2.Cells(iRow, 5).Value = Me.TextBox5.Value

    'Limpar as caixas de texto

    TextBox1.Value = Empty
    TextBox2.Value = 0
    TextBox3.Value = 0
    TextBox4.Value = 0
    TextBox5.Value = 0

        MsgBox "Registrado!"

    'Colocar o foco na primeira caixa de texto
    TextBox1.SetFocus
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/07/2016 8:05 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Infelizmente está dando alguns erros de somatória. Eu também gostaria de parar o comando se não encontrar o código.
Só faltam essa parte. Pesquisei ontem, mas não consegui fazer.

 
Postado : 29/07/2016 8:31 am
 edcronos2
(@edcronos2)
Posts: 346
Reputable Member
 

eu estou meio confuso com o seu post, já é o terceiro para a mesma coisa
o certo seria postar uma planilha com os dados e um exemplo de como vc quer que fique

 
Postado : 29/07/2016 8:50 am
 edcronos2
(@edcronos2)
Posts: 346
Reputable Member
 

fiz mais ou menos uma macros de acordo com oq entendi 

Private Sub CommandButton3_Click()

    Dim L As Long
    Total = 5    ' total de colunas
    rang = Sheets("Plan1").Range("A1", Sheets("Plan1").Cells(Sheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row, Total)).Value2
    With Sheets("Plan2")
        L2 = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
        For L = 1 To UBound(rang, 1)
            If rang(L, 1) = Val(TextBox1.Value) Then
            .Cells(L2, 1) = rang(L, 1)
                For c = 2 To Total
                   rang(L, c) = rang(L, c) + Val(Me.Controls("TextBox" & c).Value) 'soma valores
                    Sheets("Plan1").Cells(L, c) = rang(L, c) 'plan1
                    .Cells(L2, c) = rang(L, c) 'plan2
                Next
                Exit For
            End If
        Next
    End With
End Sub

sobre encerrar o codigo se não encontrar :
só sabe se não encontrou quando acaba a varredura dos codigos
oq está dando errado com a somatória?

 
Postado : 29/07/2016 9:04 am
 edcronos2
(@edcronos2)
Posts: 346
Reputable Member
 

não reparei no pedido de mensagem 

    Private Sub CommandButton3_Click()

        Dim L As Long
        Total = 5    ' total de colunas
        rang = Sheets("Plan1").Range("A1", Sheets("Plan1").Cells(Sheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row, Total)).Value2
        With Sheets("Plan2")
            L2 = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
            For L = 1 To UBound(rang, 1)
                If rang(L, 1) = Val(TextBox1.Value) Then
                .Cells(L2, 1) = rang(L, 1)
                    For c = 2 To Total
                       rang(L, c) = rang(L, c) + Val(Me.Controls("TextBox" & c).Value) 'soma valores
                        Sheets("Plan1").Cells(L, c) = rang(L, c) 'plan1
                        .Cells(L2, c) = rang(L, c) 'plan2

                    Next
msgbox "situação de " & rang(L, c) & "Atualizada "
me.TextBox1.SetFocus
                    Exit sub
                End If
            Next
        End With
msgbox "Condigo não encontrado"
me.TextBox1.SetFocus
    End Sub
 
Postado : 29/07/2016 9:48 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Olá.
A planilha em anexo está quase da forma como preciso. As operações são:
1) Ao clicar no Botão Salvar:
2) Procura código na coluna A
3) Se não encontrar, não faz absolutamente nada e exibe "Não Encontrado"
4) Se encontrar o código em A, os valores da textbox2, textbox3, textbox4 e textbox5 são somados aos valores já existentes na célula sendo coluna B, C, D e E, respectivamente. (Isto na Planilha 1)
5) Como encontrou o código, é feito um registro dos valores na Planilha 2. São somente lançados e armazenados para ter um histórico
"Dessa forma, sei qts produtos bons tem já q os com defeitos são descartados"
- O problema da soma na planilha ali anexada é q se um txtbox for ZERO ele soma 2 ao valor da célula.
- Ainda não consegui encaixar o código "Não Encontrado"

Está Quase lá essa planilha. Poderia ajudar?

 
Postado : 29/07/2016 10:28 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

rafnakb, os valores referentes aos lançamentos na Plan1 a soma é feita todas pelo TextBox3 com exceção do primeiro lançamento, é isto mesmo ?

Se for isto, teste a rotina abaixo :

Private Sub Salvar_Click()
    Dim L As Long
    Dim iRow As Long
    Dim sCodigo As String
    Dim sRw As Long
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Plan1")
    Set wS_2 = Sheets("Plan2")
    
    'Qde de linhas Plan1
    rang = wS_1.Cells(Rows.Count, 1).End(xlUp).Row
    
    sCodigo = TextBox1.Value
    
    With wS_1
        Set rng = .Range(.Cells(2, 1), .Cells(rang, 1))
    End With
    
        With rng

            Set rng = .Find(What:=sCodigo, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not rng Is Nothing Then
                sRw = rng.Row
                
                'Lançar na Plan1
                wS_1.Cells(sRw, 2).Value2 = Cells(sRw, 2).Value2 + TextBox2.Value
                wS_1.Cells(sRw, 3).Value2 = Cells(sRw, 3).Value2 + TextBox3.Value
                wS_1.Cells(sRw, 4).Value2 = Cells(sRw, 4).Value2 + TextBox3.Value
                wS_1.Cells(sRw, 5).Value2 = Cells(sRw, 5).Value2 + TextBox3.Value
                
                    'Lançar na Plan2
                    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
                    'Carregar os dados digitados nas caixas de texto para a planilha
                    wS_2.Cells(iRow, 1).Value = Me.TextBox1.Value
                    wS_2.Cells(iRow, 2).Value = Me.TextBox2.Value
                    wS_2.Cells(iRow, 3).Value = Me.TextBox3.Value
                    wS_2.Cells(iRow, 4).Value = Me.TextBox4.Value
                    wS_2.Cells(iRow, 5).Value = Me.TextBox5.Value
                
                MsgBox "Registrado com Sucesso!"
                
                Else
                
                MsgBox "Registro Não Localizado"
                
            End If
    
    End With
    
    'Limpar as caixas de texto
    TextBox1.Value = Empty
    TextBox2.Value = 0
    TextBox3.Value = 0
    TextBox4.Value = 0
    TextBox5.Value = 0

    'Colocar o foco na primeira caixa de texto
    TextBox1.SetFocus

End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 29/07/2016 1:21 pm
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Perfeito o código Mauro Coutinho.
Só uma observação: Procura no TxtBox1 e os valores não são todos do TxtBox3 não. Cada txtbox em sua respectiva coluna
TxtBox2 >> Coluna B
TxtBox3 >> Coluna C
TxtBox4 >> Coluna D
TxtBox5 >> Coluna E
Mas isso corrigi aqui sem problemas. Aliás era isso que estava dando problema na soma.
Bom, foi resolvido. Obrigado a tds. Vou CITAR tds. vlw

 
Postado : 29/07/2016 1:36 pm
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Bom dia. Gostaria de aproveitar esse tópico e apresentar um problema para que pudessem me sugerir soluções.
Acima, descrevi um pouco do que queria. Procurar código, soma com valores existentes na Plan1 e em seguida lança os valores
na plan2. Sendo assim, a Plan2 serve como um "banco de dados". Estou notando que já com muitos dados nessa pasta de trabalho
está havendo uma demora para registrar mais valores... Já que tenho além das duas planilhas mais outras quatro.

A solução que pensei foi então ter uma segunda pasta de trabalho apenas para armazenar o conteudo da plan2...

Será que poderiam dar uma força para jogar os valores da PASTA DE TRABALHO 1 - PLAN2 para a PASTA DE TRABALHO 2 - PLAN1 ?
Se tiverem uma solução mais simples para resolver a demora no registro agradeço

Private Sub Salvar_Click()
    Dim L As Long
    Dim iRow As Long
    Dim sCodigo As String
    Dim sRw As Long
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Plan1")
    Set wS_2 = Sheets("Plan2")
    
    'Qde de linhas Plan1
    rang = wS_1.Cells(Rows.Count, 1).End(xlUp).Row
    
    sCodigo = TextBox1.Value
    
    With wS_1
        Set Rng = .Range(.Cells(2, 1), .Cells(rang, 1))
    End With
    
        With Rng

            Set Rng = .Find(What:=sCodigo, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                sRw = Rng.Row
                
                'Lançar na Plan1
                wS_1.Cells(sRw, 2).Value2 = Cells(sRw, 2).Value2 + TextBox2.Value
                wS_1.Cells(sRw, 3).Value2 = Cells(sRw, 3).Value2 + TextBox3.Value
                wS_1.Cells(sRw, 4).Value2 = Cells(sRw, 4).Value2 + TextBox3.Value
                wS_1.Cells(sRw, 5).Value2 = Cells(sRw, 5).Value2 + TextBox3.Value
                
                    'Lançar na Plan2
                    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
                    'Carregar os dados digitados nas caixas de texto para a planilha
                    wS_2.Cells(iRow, 1).Value = Me.TextBox1.Value
                    wS_2.Cells(iRow, 2).Value = Me.TextBox2.Value
                    wS_2.Cells(iRow, 3).Value = Me.TextBox3.Value
                    wS_2.Cells(iRow, 4).Value = Me.TextBox4.Value
                    wS_2.Cells(iRow, 5).Value = Me.TextBox5.Value
                
                MsgBox "Registrado com Sucesso!"
                
                Else
                
                MsgBox "Registro Não Localizado"
                
            End If
    
    End With
    
    'Limpar as caixas de texto
    TextBox1.Value = Empty
    TextBox2.Value = 0
    TextBox3.Value = 0
    TextBox4.Value = 0
    TextBox5.Value = 0

    'Colocar o foco na primeira caixa de texto
    TextBox1.SetFocus
 
Postado : 02/08/2016 7:46 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Se eu fosse jogar os dados que seriam salvos na plan2 numa pasta de trabalho 2 e planilha 1, apenas como banco de dados.
Como posso fazer isso ?
Com o numero de dados grandes aqui na minha pasta de traballho 1, está lento a gravação. Acho que a solução seria
uma pasta de trabalho somente para os dados da plan2...

No que eu clico no botão SALVAR, ao invés de ir para a plan2 da mesma pasta de trabalho, os dados vai até a plan1 de uma segunda pasta de trabalho...

Entendeu ?

 
Postado : 02/08/2016 8:42 am
Forum Jump:
  Tópico Anterior
Próximo Tópico