Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Item novo ou somar ...
 
Notifications
Clear all

Item novo ou somar quantidade de item já existente - VBA

 
2024 - VBA & Macros
Post Recente por Madi Land 10 anos atrás
3 Posts
2 Usuários
0 Reactions
995 Visualizações
RSS
 Madi Land
(@madi-land)
Posts: 33
Eminent Member
Topic starter
 

Boa noite.

Não estou conseguindo fazer uma parte do meu programa funcionar. Para mim a lógica está correta, mas não sei porque não está funcionando.

Segue em anexo o arquivo.

O QUE É PARA ACONTECER:
Na "plan8 (UCD_Estq.)" na parte "SALDO TOTAL", será alimentada conforme os itens vão entrando ou saindo.

PARTICULARIDADES:
* Se, na hora de inserir um item e este item já estiver lançado na tabela "SALDO TOTAL", ou seja, se houver um item com a "DESIGNAÇÃO" e com "TAMANHO" igual, na mesma linha, a "QUANTIDADE" será somada com a quantidade do item que está sendo inserido.

* Caso o item não esteja lançado na tabela "SALDO TOTAL", este item será lançado na próxima linha vazia.

COMO TESTAR ESTA PARTE DO PROGRAMA:
1) Na planilha "INICIAL", clicar em "Entrada de perfis".
2) Clicar na opção "CHAPA DOBRADA"
3) Tipo de perfil --> "U_CD (Perfil U)"
4) DESIGNAÇÃO --> Qualquer item que já está cadastrado
5) QUANTIDADE --> Qualquer número
6) TAMANHO --> Qualquer número
7) "CONFIRMAR ENTRADA"

O formulário que se refere à este item é "frm_entrada_perfis" ----> Botão "cmd_confirmar"

Segue abaixo o código da parte do SALDO TOTAL

'...:: SALDO TOTAL ::...

Dim sDesignacao
Dim sTamanho
Dim sCel
Dim sRg As Range
    
    sDesginacao = cmb_designacao.Text
    sTamanho = txttamanho.Text
    
Set sRg = Range("BE8:BE20")

    For Each sCel In sRg
     
        If sCel.Value = sDesignacao And sCel.Offset(0, 2).Value = sTamanho Then
        
        sCel.Select
                
        ' Soma a quantidade de entrada com a quantidade do perfil que já existe no estoque (SALDO TOTAL)
        ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1) + txtquatidade  'ActiveCell.Offset(0, 1).Value --> Quantidade que tem no SALDO TOTAL
            
         Else ' Se o perfil não tiver o tamanho já cadastrado, lançar o perfil na próxima linha vazia
            
         Application.Goto Reference:="OFFSET(R7C57,COUNTA(R8C57:R1000000C57)+1,0)" 'Vai para a próxima linha vazia
            
            ActiveCell.Value = cmb_designacao.Text
            ActiveCell.Offset(0, 1).Value = txtquantidade.Text
            ActiveCell.Offset(0, 2).Value = txttamanho.Text
            ActiveCell.Offset(0, 3).Value = txtpeso.Text
            
        End If
        
     Next

Para desproteger a planilha 8, a senha é "LAND".

Fico no aguardo por uma ajuda....

 
Postado : 05/05/2015 3:58 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Em sua rotina de comparação, algumas variáveis estão com descrição divergentes (por exemplo sDesignacao vs sDesiginacao), bem como o nome do campo txtquantidade.
Tambem como definiu uma range BE8:BE20, mesmo encontrando o valor, irá inserir dados até a linha 20 senão houver.
Experimente com a rotina alterada abaixo:

Private Sub cmd_confirmar_Click()

Plan8.Unprotect "LAND"

Application.Goto Reference:="OFFSET(R7C1,COUNTA(R8C1:R1000000C1)+1,0)"

ActiveCell.Value = txtcodigo.Text
ActiveCell.Offset(0, 1).Value = cmb_designacao.Text
ActiveCell.Offset(0, 2).Value = txtquantidade.Text
ActiveCell.Offset(0, 3).Value = txttamanho.Text
ActiveCell.Offset(0, 4).Value = txtpeso.Text
ActiveCell.Offset(0, 5).Value = cmb_destino.Text
ActiveCell.Offset(0, 6).Value = txtidentifica.Text
ActiveCell.Offset(0, 7).Value = txtobservacao.Text
ActiveCell.Offset(0, 8).Value = lbldata
ActiveCell.Offset(0, 9).Value = cmbfornecedor.Text
ActiveCell.Offset(0, 10).Value = txtnfe.Text

'Condição para gravar os dados na ENTRADA ou SAÍDA e se for LAND, METALMAR ou CLIENTE, e SALDO TOTAL

'...:: LAND ::...
    If cmb_destino.Text = "LAND" Then

    Application.Goto Reference:="OFFSET(R7C29,COUNTA(R8C29:R1000000C29)+1,0)" 'Seleciona nova linha na SALDO LAND
    
    ActiveCell.Value = cmb_designacao.Text
    ActiveCell.Offset(0, 1).Value = txtquantidade.Text
    ActiveCell.Offset(0, 2).Value = txttamanho.Text
    ActiveCell.Offset(0, 3).Value = txtpeso.Text
    
    End If

'...:: METALMAR ::...
    If cmb_destino.Text = "METALMAR" Then
 
    Application.Goto Reference:="OFFSET(R7C36,COUNTA(R8C36:R1000000C36)+1,0)"
 
    ActiveCell.Value = cmb_designacao.Text
    ActiveCell.Offset(0, 1).Value = txtquantidade.Text
    ActiveCell.Offset(0, 2).Value = txttamanho.Text
    ActiveCell.Offset(0, 3).Value = txtpeso.Text
 
    End If

'...:: CLIENTE ::...
    If cmb_destino.Text = "CLIENTE" Then
 
    Application.Goto Reference:="OFFSET(R7C44,COUNTA(R8C44:R1000000C44)+1,0)"
 
    ActiveCell.Value = cmb_designacao.Text
    ActiveCell.Offset(0, 1).Value = txtquantidade.Text
    ActiveCell.Offset(0, 2).Value = txttamanho.Text
    ActiveCell.Offset(0, 3).Value = txtpeso.Text
    ActiveCell.Offset(0, 4).Value = txtidentifica.Text
    ActiveCell.Offset(0, 5).Value = txtobservacao.Text
    ActiveCell.Offset(0, 6).Value = cmbfornecedor.Text
    ActiveCell.Offset(0, 7).Value = txtnfe.Text
   
    End If

'...:: SALDO TOTAL ::...

Dim sDesignacao As String
Dim sTamanho As Integer, uLin As Long
Dim sCel As Range
Dim sRg As Range
    
    sDesignacao = cmb_designacao.Text
    sTamanho = txttamanho.Text
uLin = Cells(Cells.Rows.Count, "BE").End(xlUp).Row
If uLin < 8 Then uLin = 8
Set sRg = Range("BE8:BE" & uLin)

    For Each sCel In sRg
     
        If sCel.Value = sDesignacao And sCel.Offset(0, 2).Value = sTamanho Then
        sCel.Select
                
        ' Soma a quantidade de entrada com a quantidade do perfil que já existe no estoque (SALDO TOTAL)
        ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1) + (txtquantidade * 1) 'ActiveCell.Offset(0, 1).Value --> Quantidade que tem no SALDO TOTAL
            
         Else ' Se o perfil não tiver o tamanho já cadastrado, lançar o perfil na próxima linha vazia
            
         Application.Goto Reference:="OFFSET(R7C57,COUNTA(R8C57:R1000000C57)+1,0)" 'Vai para a próxima linha vazia
            
            ActiveCell.Value = cmb_designacao.Text
            ActiveCell.Offset(0, 1).Value = txtquantidade.Text
            ActiveCell.Offset(0, 2).Value = txttamanho.Text
            ActiveCell.Offset(0, 3).Value = txtpeso.Text
            
        End If
        
     Next

    MsgBox ("Item inserido com sucesso.")
        

'Limpa todos os campos após a confirmação
cmb_designacao.Text = ""
txtcodigo.Text = Plan8.Range("k1").Value
txtquantidade.Text = ""
txttamanho.Text = ""
txtpeso.Text = ""
cmb_destino.Text = ""
txtidentifica.Text = ""
txtobservacao.Text = ""

op_chapa_dobrada.SetFocus


Plan8.Protect "LAND"

End Sub
Private Sub cmd_sair_Click()
Unload Me

Plan2.Select

End Sub

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

 
Postado : 07/05/2015 10:42 am
 Madi Land
(@madi-land)
Posts: 33
Eminent Member
Topic starter
 

Boa noite. Agradeço a atenção e a ajuda, porém ainda não estou conseguindo fazer o programa funcionar conforme preciso.

OQUE ESTÁ ACONTECENDO:
Na seguinte condição:

If sCel.Value = sDesignacao And sCel.Offset(0, 2).Value = sTamanho Then
        sCel.Select
                
        ' Soma a quantidade de entrada com a quantidade do perfil que já existe no estoque (SALDO TOTAL)
        ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1) + (txtquantidade * 1) 'ActiveCell.Offset(0, 1).Value --> Quantidade que tem no SALDO TOTAL
            
         Else ' Se o perfil não tiver o tamanho já cadastrado, lançar o perfil na próxima linha vazia
            
         Application.Goto Reference:="OFFSET(R7C57,COUNTA(R8C57:R1000000C57)+1,0)" 'Vai para a próxima linha vazia
            
            ActiveCell.Value = cmb_designacao.Text
            ActiveCell.Offset(0, 1).Value = txtquantidade.Text
            ActiveCell.Offset(0, 2).Value = txttamanho.Text
            ActiveCell.Offset(0, 3).Value = txtpeso.Text
            
        End If

Só está funcionando se eu não tenho nenhuma célula com valor preenchido, na tabela SALDO TOTAL, igual ao valor que será inserido pelo formulário.

Se na tabela SALDO TOTAL, eu tiver alguma célula com a DESIGNACAO igual a designação do formulário ou o TAMANHO igual ao tamanho do formulário, a soma do item cadastrado está acontecendo, porém o mesmo item é adicionado na última linha também.

**********************************************************************************************************************
COMO DEVE FUNCIONAR ESTA TABELA:

SE no formulário de entrada, a DESIGNAÇÃO e o TAMANHO já estiverem sido lançados na tabela SALDO TOTAL ENTÃO

a quantidade da tabela deste item, será somada com a quantidade do item no formuláio

SENÃO

SE no formulário de entrada, (a DESIGNAÇÃO for igual a DESIGNAÇÃO tabela SALDO TOTAL porém com TAMANHO diferente da tabela SALDO TOTAL) OU (a DESIGNAÇÃO for diferente da DESIGNAÇÃO da tabela SALDO TOTAL)

este item deverá ser adicionado ma próxima linha vazia da tabela SALDO TOTAL.
**********************************************************************************************************************

Como tentei executar esta parte, mas não obtive sucesso:

'...:: SALDO TOTAL ::...

Dim sDesignacao As String
Dim sTamanho As Integer, uLin As Long
Dim sCel As Range
Dim sRg As Range
    
    sDesignacao = cmb_designacao.Text
    sTamanho = txttamanho.Text
uLin = Cells(Cells.Rows.Count, "BE").End(xlUp).Row
If uLin < 8 Then uLin = 8
Set sRg = Range("BE8:BE" & uLin)

    For Each sCel In sRg
     
        If sCel.Value = sDesignacao And sCel.Offset(0, 2).Value = sTamanho Then
        sCel.Select
                
        ' Soma a quantidade de entrada com a quantidade do perfil que já existe no estoque (SALDO TOTAL)
        ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1) + (txtquantidade * 1) 'ActiveCell.Offset(0, 1).Value --> Quantidade que tem no SALDO TOTAL
            
         Else ' Se o perfil não tiver o tamanho já cadastrado, lançar o perfil na próxima linha vazia
        
         If (sCel.Value = sDesignacao And sCel.Offset(0, 2).Value <> sTamanho) Or (sCel.Value <> sDesignacao And sCel.Offset(0, 2).Value <> sTamanho) Then
            
         Application.Goto Reference:="OFFSET(R7C57,COUNTA(R8C57:R1000000C57)+1,0)" 'Vai para a próxima linha vazia
            
            ActiveCell.Value = cmb_designacao.Text
            ActiveCell.Offset(0, 1).Value = txtquantidade.Text
            ActiveCell.Offset(0, 2).Value = txttamanho.Text
            ActiveCell.Offset(0, 3).Value = txtpeso.Text
            
        End If
        End If
        
     Next

Fico no aguardo pela ajuda, por favor...

Obrigado desde já...

Abrass

 
Postado : 09/05/2015 5:42 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico