Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

walber luiz

Adaptar código ao gerar reletorio

Por , em Visual Basic

Recommended Posts

walber luiz    0

walber luiz
Postado

Boa Noite

 

Alguém poderia me ajudar com este código???.

Não manjo muito de VBA por isso recorro aos experts.

Criei está planilha olhando tutoriais e fóruns, mas não estou conseguindo adaptar este código .

Quero que quando ele puxe as informações da planilha que ele some o que for igual e mantem os valores.

A imagem 1 mostra como ele gera o relatório e a imagem 2 mostra como quero que seja se for possível.

E também gostaria  que fosse feito a soma da coluna na textbox.

Vendas seja somado a coluna Valor Total e nas Compras a coluna Total

TESTE.xlsm

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic

  • Conteúdo Similar

    • Fabio de Souza
      Problema com código "CDATE" em célula Vazia, VBA Excel9
      Por Fabio de Souza
      Ola amigos é minha primeira vez no forum,
       
      Estou com o seguinte problema:
       
      efetuei uma planilha em vba excel, porem em uma determinada textbox, estou tendo dor de cabeça,
      fiz uma tabela que busca de valores e insere de valores.
       
      Na tabela fde inserção de valores, tudo, ok
      efetuei a formula com comando Cdate(textde) - quando preenche a mesma ela inserre corretamente em formato de datas porem,
      na  busca de valores quando a celula na estão preenchida ele nãos tras nada nesta txtDE, e quando eu efetuo a alteração ele da erro,
      porque na opção "Cdade" tem que esdta preenchida com alguma coisa...
       
       
      consegume me ajudar?
      ' este faz a busca de valores:
       
      Private Sub txtLocaliza_AfterUpdate()
      Dim intervalo As Range
      Dim texto As String
      Dim codigo As Integer
      Dim pequisa
      Dim mensagem
          codigo = txtLocaliza.Value
      'Sheets("Clientes").Select
      Set intervalo = Sheets("Clientes").Range("A:Y")
      On Error GoTo trataErro
      pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, False)
      pesq1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 3, False)
      pesq2 = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
      pesq3 = Application.WorksheetFunction.VLookup(codigo, intervalo, 5, False)
      pesq4 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
      pesq5 = Application.WorksheetFunction.VLookup(codigo, intervalo, 7, False)
      pesq6 = Application.WorksheetFunction.VLookup(codigo, intervalo, 8, False)
      pesq7 = Application.WorksheetFunction.VLookup(codigo, intervalo, 9, False)
      pesq8 = Application.WorksheetFunction.VLookup(codigo, intervalo, 10, False)
      pesq9 = Application.WorksheetFunction.VLookup(codigo, intervalo, 11, False)
      pesq10 = Application.WorksheetFunction.VLookup(codigo, intervalo, 12, False)
      pesq11 = Application.WorksheetFunction.VLookup(codigo, intervalo, 13, False)
      pesq12 = Application.WorksheetFunction.VLookup(codigo, intervalo, 14, False)
      pesq13 = Application.WorksheetFunction.VLookup(codigo, intervalo, 15, False)
      pesq14 = Application.WorksheetFunction.VLookup(codigo, intervalo, 16, False)
      pesq15 = Application.WorksheetFunction.VLookup(codigo, intervalo, 17, False)
      pesq16 = Application.WorksheetFunction.VLookup(codigo, intervalo, 18, False)
      pesq17 = Application.WorksheetFunction.VLookup(codigo, intervalo, 19, False)
      pesq18 = Application.WorksheetFunction.VLookup(codigo, intervalo, 20, False)
      pesq19 = Application.WorksheetFunction.VLookup(codigo, intervalo, 21, False)
      pesq20 = Application.WorksheetFunction.VLookup(codigo, intervalo, 22, False)
      pesq21 = Application.WorksheetFunction.VLookup(codigo, intervalo, 23, False)
      pesq22 = Application.WorksheetFunction.VLookup(codigo, intervalo, 24, False)
      pesq23 = Application.WorksheetFunction.VLookup(codigo, intervalo, 25, False)
      pesq24 = Application.WorksheetFunction.VLookup(codigo, intervalo, 1, False)
      lblCod = pesq24
      txtAddress = CDate(pesquisa)
      txtNumber = pesq1
      txtNeighb = pesq2
      txtCity = pesq3
      cbUF = pesq4
      txtDDD1 = Format(CCur(pesq5), "#0.000")
      txtPhone1 = Format(CCur(pesq6), "#0.000")
      txtDDD2 = Format(CCur(pesq7), "#0.000")
      txtPhone2 = Format(CCur(pesq8), "#0.000")
      txtEmail = Format(CCur(pesq9), "#0.000")
      txtmn = Format(CCur(pesq10), "#0.000")
      txtti = Format(CCur(pesq11), "#0.000")
      txtal = Format(CCur(pesq12), "#0.000")
      txtcomplemento = pesq13
      If pesq14 <> "" Then
      txtDT = CDate(pesq14)
      End If
      txtIN = pesq15
      txtTR = pesq16
      ''If pesq17 <> "" Then
      txtPeso = Format(CCur(pesq17), "###,##0.000")
      ''End If
      txtPecas = pesq18
      ''If pesq19 <> "" Then
      txtPB = Format(CCur(pesq19), "###,##0.000")
      ''End If
      ''If pesq20 <> "" Then
      txtPL = Format(CCur(pesq20), "###,##0.000")
      ''End If
      If pesq21 <> "" Then
      txtDE = CDate(pesq21)
      End If
      txtDS = pesq22
      txtVT = pesq23
      Exit Sub
      trataErro:
         texto = "Não Localizado"
         mensagem = MsgBox(texto, vbOKOnly + vbInformation)
      End Sub
       
      'este altera na tabela
       
      Sub lsAlterarStudent()
          
          'Define a Range de Pesquisa
          Set currentFind = Worksheets("Clientes").Range("A:A").Find(frmCadastroStudents.lblCod, , _
              Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
              Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
              
          lLinha = currentFind.Row
          
          With frmCadastroStudents
              Sheets("Clientes").Cells(lLinha, 2).Value = CDate(.txtAddress)
              Sheets("Clientes").Cells(lLinha, 3).Value = .txtNumber
              Sheets("Clientes").Cells(lLinha, 4).Value = .txtNeighb
              Sheets("Clientes").Cells(lLinha, 5).Value = .txtCity
              Sheets("Clientes").Cells(lLinha, 6).Value = .cbUF
              Sheets("Clientes").Cells(lLinha, 7).Value = CCur(.txtDDD1)
              Sheets("Clientes").Cells(lLinha, 8).Value = CCur(.txtPhone1)
              Sheets("Clientes").Cells(lLinha, 9).Value = CCur(.txtDDD2)
              Sheets("Clientes").Cells(lLinha, 10).Value = CCur(.txtPhone2)
              Sheets("Clientes").Cells(lLinha, 11).Value = CCur(.txtEmail)
              Sheets("Clientes").Cells(lLinha, 12).Value = CCur(.txtmn)
              Sheets("Clientes").Cells(lLinha, 13).Value = CCur(.txtti)
              Sheets("Clientes").Cells(lLinha, 14).Value = CCur(.txtal)
              Sheets("Clientes").Cells(lLinha, 15).Value = .txtcomplemento
              Sheets("Clientes").Cells(lLinha, 16).Value = CDate(.txtDT)
              Sheets("Clientes").Cells(lLinha, 17).Value = .txtIN
              Sheets("Clientes").Cells(lLinha, 18).Value = .txtTR
              
          ''If txtPeso <> "" Then
              Sheets("Clientes").Cells(lLinha, 19).Value = CCur(.txtPeso)
          ''End If
              
              Sheets("Clientes").Cells(lLinha, 20).Value = .txtPecas
                      
          ''If txtPB <> "" Then
              Sheets("Clientes").Cells(lLinha, 21).Value = CCur(.txtPB)
          ''End If
              
          ''If txtPL <> "" Then
              Sheets("Clientes").Cells(lLinha, 22).Value = CCur(.txtPL)
          ''End If
              
          ''If txtDE <> "" Then
              Sheets("Clientes").Cells(lLinha, 23).Value = CDate(.txtDE)
          ''End If
          
              Sheets("Clientes").Cells(lLinha, 24).Value = .txtDS
              Sheets("Clientes").Cells(lLinha, 25).Value = .txtVT
              
          End With
      End Sub
       
       
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito