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!
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ç.
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
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!
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!
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
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ç.
Perfeito mais uma vez e obrigado Mauro e AdolfoLima pela atenção dispensada.
Click em
se a resposta foi util!
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
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
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ç.
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!
Ok Basole. Valeu.
Gnd abç.