Notifications
Clear all

Código para substituir formulas

13 Posts
3 Usuários
0 Reactions
2,575 Visualizações
Basole
(@basole)
Posts: 487
Reputable Member
Topic starter
 

Boa Noite!

A todos, eu ainda estou engatinhando no vba, por isso venho pedir ajuda, pois estou tentando substituir as formulas por um código desta planilha de cotação de preços em anexo.

Desde já agradeço a atenção.

Abç.

Click em se a resposta foi util!

 
Postado : 01/08/2013 8:13 pm
AdolfoLima
(@adolfolima)
Posts: 27
Eminent Member
 

Oi Basole.

Coloca o código abaixo em algum módulo:

Sub EncontraMenorCusto()
Dim i, ii As Integer
Dim Valor
Dim Fornecedor As String
 
' Varredura de linhas
For i = 2 To 2000
    Valor = Plan1.Cells(i, 2)
    Fornecedor = Plan1.Cells(1, 2)

    If Plan1.Cells(i, 1) = "" Then Exit Sub ' Verifica se há produto para analizar
    
    For ii = 2 To 6                     ' Varredura de colunas
        If Plan1.Cells(i, ii) = "" Then
            GoTo Segue
        End If
        
        If Plan1.Cells(i, (ii + 1)) = "" Then
            GoTo Segue
        Else
            If Valor <= Plan1.Cells(i, (ii + 1)) Then
                'Valor = Plan1.Cells(i, ii)
                'Fornecedor = Plan1.Cells(1, ii)
            Else
                Valor = Plan1.Cells(i, (ii + 1))
                Fornecedor = Plan1.Cells(1, (ii + 1))
            End If
        End If
Segue:
    Next ii

Plan1.Cells(i, 9) = Valor
Plan1.Cells(i, 10) = Fornecedor

Valor = 0
Fornecedor = ""
Next i
End Sub

Gnd abç. ;)

 
Postado : 01/08/2013 10:35 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Poderia estar utilizando tambem as funções correspondentes em VBA:

Me basiei pelo seu modelo, onde os dados vão até A19 e em A20 você tem a palavra Continua..., não entendi a razão da mesma, mas qualquer coisa é só ajustar na rotina.

Sub FindMenor_HLookup()
    Dim lastRow As Long
    Dim r As Range
    Dim iMenor As String
    Dim iLin
    Dim sLocalizou As String
    Dim i_Lin_Lookup
 
    i_Lin_Lookup = 21
    
    lastRow = Plan1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    
    For iLin = 2 To lastRow
       
       With Plan1
           
            Set r = .Range("B" & iLin & ":G" & iLin)
           
            iMenor = Application.WorksheetFunction.Small(r, 1)

            Range("I" & iLin).Value = CDbl(iMenor)
           
            sLocalizou = WorksheetFunction.HLookup(.Range("I" & iLin).Value, _
                    .Range("B" & iLin & ":G22"), i_Lin_Lookup, False)
        
            Range("J" & iLin).Value = sLocalizou
        
            i_Lin_Lookup = i_Lin_Lookup - 1

       End With
       
     Next
     
End Sub

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

 
Postado : 02/08/2013 6:25 am
Basole
(@basole)
Posts: 487
Reputable Member
Topic starter
 

Perfeito AdolfoLima e Mauro, Maravilha.
Mauro qto. a palavra continua, é porque as vezes temos 490 linhas e 18 fornecedores aproximadamente.

Eu só me esqueci de acrescentar na formula um SE(" ";..), para no caso de nenhum fornecedor enviar um preço ao um determinado produto, ou seja alguma linha ficar totalmente sem valores.

Click em se a resposta foi util!

 
Postado : 02/08/2013 11:06 am
Basole
(@basole)
Posts: 487
Reputable Member
Topic starter
 

AdolfoLima e Mauro, poderiam acrescentar no codigo para não gerar um "ERRO" no caso de nenhum fornecedor enviar um preço ao um determinado produto, ou seja alguma linha ficar totalmente sem valores ?

Click em se a resposta foi util!

 
Postado : 02/08/2013 12:18 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Basole, troque a rotina anterior por esta :

Sub FindMenor_HLookup()
    Dim lastRow As Long
    Dim r As Range
    Dim iMenor As String
    Dim iLin
    Dim sLocalizou As String
    Dim i_Lin_Lookup
    Dim sSoma
    
    i_Lin_Lookup = 21
    
    lastRow = Plan1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    
    For iLin = 2 To lastRow
       
       With Plan1
           'Define o Range
            Set r = .Range("B" & iLin & ":G" & iLin)
            
            'Soma os Valores no Range
            sSoma = Application.Sum(r)
            
            'Se a Soma for Menor ou igual aZero
            If sSoma <= 0 Then
                'Preenche com zero e texto informando
                Range("I" & iLin).Value = 0
                Range("J" & iLin).Value = "Preço não Informado"
                
                'Incrementa a Variável
                i_Lin_Lookup = i_Lin_Lookup - 1
                
            Else 'Soma Maior que zero
                'Preenche com os Dados
                iMenor = Application.WorksheetFunction.Small(r, 1)
                Range("I" & iLin).Value = CDbl(iMenor)
                sLocalizou = WorksheetFunction.HLookup(.Range("I" & iLin).Value, _
                        .Range("B" & iLin & ":G22"), i_Lin_Lookup, False)
            
                Range("J" & iLin).Value = sLocalizou
                
                'Incrementa a Variável
                i_Lin_Lookup = i_Lin_Lookup - 1

            End If

       End With
       
     Next
     
End Sub

[]s

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

 
Postado : 02/08/2013 5:35 pm
AdolfoLima
(@adolfolima)
Posts: 27
Eminent Member
 

Oi Mauro.

Uma curiosidade: Como minhas planilhas são usadas na empresa e em diversos computadores e versões, sempre que posso evito o uso de funções do próprio Excel porque dependendo da versão do Office pode dar erro em algumas. Tua rotina, por exemplo, em minha versão 2013 deu o seguinte erro:

Erro em tempo de execução '1004'
Não é possível obter a propriedade HLookup da classe WorksheetFunction

Pergunto: :?:
De modo geral, será que tem como contornar estes problemas de versões?
Você sabe se alguém tem uma lista de funções do Excel que seja comum a todas as versões e portanto utilizáveis sem problema?

Gnd abç. ;)

 
Postado : 02/08/2013 6:44 pm
Basole
(@basole)
Posts: 487
Reputable Member
Topic starter
 

Perfeito mais uma vez e obrigado Mauro e AdolfoLima pela atenção dispensada.

Click em se a resposta foi util!

 
Postado : 02/08/2013 7:08 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Adolfo, não tenho o excel 2013 para testar, mas esta função está presente nesta versão, no site abaixo temos a relação de várias funções, aplicação e a qual versão se aplica.
MS Excel: HLOOKUP Function (WS)
Applies To :
Excel 2013, Excel 2011 for Mac, Excel 2010, Excel 2007, Excel 2003, Excel XP, Excel 2000

http://www.techonthenet.com/excel/formulas/hlookup.php

MS Excel: ALL Functions - Category
http://www.techonthenet.com/excel/formulas/index.php

Quanto ao erro, a principio não tem nada a ver com compatibilidade de versão, a mensagem de erro está sinalizando algum elemento que não está dentro dos ranges, deixa ver se consigo exemplificar :

As duas rotinas abaixo, a principio são identicas, o diferencial é que a primeira irá retornar o Valor correto, e a segunda irá dar a mensagem de erro que citou, coloquei para pegar somente um valor para teste e poder exemplificar melhor e com os Ranges definidos nas mesmas :

Se utilizar estas rotina no exemplo que o Basole anexou :
Esta irá devolver no MsgBox : fornecedor3

Sub Teste_HLookup_OK()
    Dim sLocalizou  As String
    
    With Worksheets("Plan1")
        sLocalizou = WorksheetFunction.HLookup(.Range("$I$2").Value, .Range("$B$2:$G$22"), 21, False)
    End With

    MsgBox sLocalizou
    
End Sub

Esta irá dar o erro que citou.

Sub Teste_HLookup_Com_Erro()
    Dim sLocalizou  As String
    
    With Worksheets("Plan1")
        sLocalizou = WorksheetFunction.HLookup(.Range("$I$3").Value, .Range("$B$3:$G$23"), 21, False)
    End With

    MsgBox sLocalizou
    
End Sub

Agora observe a diferença nas duas, é devido aos Ranges a condição final:
Range("$I$3").Value, .Range("$B$3:$G$23"), 21

Então, como na rotina que enviei estamos utilizando algumas Variáveis fixas e outras Incrementadas, pode ser que se estiver utilizando em um outro modelo com colunas e linhas diferentes, teremos de ajustar estas variáveis:
As Variáveis que citei seriam :
i_Lin_Lookup = 21
............................................
sLocalizou = WorksheetFunction.HLookup(.Range("I" & iLin).Value, _
.Range("B" & iLin & ":G22"), i_Lin_Lookup, False)

Estas são Variáveis Fixas definidas diretamente na rotina, e não estão sendo incrementadas.

Espero ter conseguido explicar e ajudar, copie as rotinas acima, faça os testes e qualquer coisa retorne.

[]s

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

 
Postado : 02/08/2013 7:29 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Uma Obs quanto a sua Rotina que indicou, tem de fazer ajuste na linha For :

For ii = 2 To 6
Aqui estamos indicando Colunas "B até F"

E o correto seria : "B até G"
Então alteramo de 6 para 7
For ii = 2 To 7

Apos executar a sua rotina, analise os valores e verá que nem todos estão corretos, mas fazendo a alteração acima, teremos os resultados positivos

[]s

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

 
Postado : 02/08/2013 7:48 pm
AdolfoLima
(@adolfolima)
Posts: 27
Eminent Member
 

Valeu Mauro. Vou estudar a função. Muito bom o link do site com as funções.

Também encontrei este em português que faz um paralelo Ingles / Português.

http://usuariosdoexcel.wordpress.com/lista-de-funcoes-do-excel/

Gnd abç. ;)

 
Postado : 02/08/2013 9:17 pm
Basole
(@basole)
Posts: 487
Reputable Member
Topic starter
 

Olá AdolfoLima, só pra registrar, fiz uns testes com o seu código, e verifiquei que na hipótese do "fornecedor 1", não enviar o preço de um produto, ele não compara os outros valores das colunas seguintes, (como se a linha estivesse toda em branco).

Click em se a resposta foi util!

 
Postado : 03/08/2013 7:22 am
AdolfoLima
(@adolfolima)
Posts: 27
Eminent Member
 

Ok Basole. Valeu.

Gnd abç. ;)

 
Postado : 03/08/2013 8:37 am