Neodenn

Alguém sabe por que está dando erro? Creio que o problema esteja no uso do IF(AND - na propia estrutura; [fornecedor] e [equipamentos_custo_total] são chaves existentes que estão funcionando ok! IF(AND([fornecedor]="ECORI";[cliente_estado]="SP";[equipamentos_custo_total]*0.025); IF(AND([fornecedor]="ECORI";[cliente_estado]="GO";[equipamentos_custo_total]*0.035); IF(AND([fornecedor]="ECORI";[cliente_estado]="MG");[equipamentos_custo_total]*0.038); IF(AND([fornecedor]="ECORI";[cliente_estado]="MS");[equipamentos_custo_total]*0.05); IF(AND([fornecedor]="ECORI";[cliente_estado]="MT");[equipamentos_custo_total]*0.054); IF(AND([fornecedor]="ECORI";[cliente_estado]="TO");[equipamentos_custo_total]*0.054); IF(AND([fornecedor]="ECORI";[cliente_estado]="BA");[equipamentos_custo_total]*0.06); 0)))))))

Funcionou! Perfeito, agora vou adequar para a minha tabela, obrigado!!!

Bom Dia! Estou tentando solucionar um problema: Tenho que atualizar itens em massa no meu BD. Pensei numa solução, mas não consegui realizar. Seria assim, de modo simpificado: No BD, ja tem itens cadastrados com valor e id do produto. minha ideia é, por meio de outra aba escrever o id de um produto e um novo valor, e esse valor substitui o valor da aba de BD. Criei uma tabela basica para exemplificar. Se alguém tiver uma ideia para me ajudar, ficaria muito grato. OBS: Teria que ser em VBA ATUALIZAR VALORES.xlsx

Show de bola cara, Fiz algumas alterações no seu código, agora está funcionando como queria.

Bom dia! Estou tentado desenvolver um código que de 54 em 54 linhas verifica a propia linha e mais duas abaixo, caso todas elas estejam vazias, encerrar o código. Caso uma delas estiverem preenchidas, iniciar a próxima verificação. O intuito desse código é criar marcações para quebra de página automaticamente. Na minha configuração, as paginas acabam de 54 em 54 linhas. O código para marcar a quebra de página é esse: ActiveSheet.PageSetup.PrintArea = "$A$1:$F$54" Com o código em mãos é apenas questão de substituir esse intervalo por variáveis. Se puderem me ajudar, desde já grato!

@DJunqueira Obrigado pela ajuda, nunca trabalhei com segmentação de dados, então fiz alguns testes e não consegui usar direito , mas valeu o esforço. Não conhecia essa função do excel, vou procurar me aprofundar nela.

Alguém tem outra ideia para me ajudar nessa situação?

@DJunqueira Obrigado pela ajuda! Havia pensado em fazer algo assim, porém as alturas são variáveis, não tem um padrão, o que impossibilita essa solução. Independente de tudo, valeu o esforço, obrigado!

Bom dia! Tenho uma Planilha como a descrita abaixo: Gostaria de saber se há uma forma de Somar usando os seguintes criterios: PIR ser o mesmo Altura ser a mesma O que somar? Quantidade Se seguir essa lógica, esta tabela deveria aparecer desta forma: Poderia ser em outra tabela sem problemas, preciso apenas que faça essa somatória e resuma. Desde já, grato! SOMA REPETIDOS.xlsx

Daria para colar usando SendKeys "^v", tambem dá certo, funciona exatamente como se voce estivesse digitando CTRL+V

@AfonsoMira Pra mim não daria certo, pois há varias imagens e chama-las por nome não é bem a intenção do código, mas obrigado pelo seu tempo e esforço. Depois de bastante tempo batendo a cabeça, cheguei no seguinte código: < Option Explicit Sub IsNewGerar() Dim ActSheet As Worksheet Dim SelRange As Range Set ActSheet = ActiveSheet Set SelRange = Selection ActSheet.Select SelRange.Select SelRange.Activate Selection.Copy End Sub > Funcionou perfeitamente, copia tudo o que foi selecionado, dai posso manipular tais dados como quiser. Desta forma, todas as imagens na seleção também são copiadas.

Boa tarde, É possível selecionar um intervalo e copiar o texto e as imagens desta seleção para colar posteriormente? O codigo que estou utilizando é o seguinte < Selection.Copy Range("A1").SpecialPaste > Desta maneira ele copia e cola a seleção, porém as imagens não coladas. Desde já Grato!

@gustavoomt Veja se assim lhe atende: Foi usado a função SOMASE apenas... =SOMASE(I3:I32;"Pendente";E3:E32) --> E33 =SOMASE(I3:I32;"Pago";E3:E32) --> E34 SALDO PENDENTE-PAGO.xlsx

@Midori Funcionou perfeitamente, obrigado!!! Exatamente!

Bom dia! Gostaria de saber se tem como uma macro ser executada somente se houver a worksheet "ORÇAMENTO", algo como '< Inicio Modulo 1 começo Macro A Fim Macro A Chamar Macro A na worksheet "ORÇAMENTO" Fim Modulo 1 '> Seria mais fácil se eu colocasse a call na Aba "ORÇAMENTO", porém no meu caso isso não é possível. Poderiam me ajudar? Desde já grato!

@Midori Obrigado, estava vendo a situação da maneira mais difícil! Bastou substituir ao final da primeira Function: < End If Extenso_Valor = "(" & strMoeda & ")" End Function >

@AfonsoMira É claro! Segue < Function Extenso_Valor(valor As Double) As String Dim strMoeda As String Dim cents As Variant Dim decimalSep As String ' Se o valor for igual ou maior que 1 quatrilhao ' passar erro e sair da funcao If valor > 999999999999999# Then Extenso_Valor = "Valor excede 999.999.999.999.999" Exit Function End If ' Se valor for igual a 1, a unidade está no singular If WorksheetFunction.RoundDown(valor, 0) = 1 Then ' a string da moeda no singular strMoeda = " real)" ' Se for maior que 1 a unidade está no plural ElseIf WorksheetFunction.RoundDown(valor, 0) > 1 Then strMoeda = " reais)" End If ' Remove os centavos cents = valor - WorksheetFunction.RoundDown(valor, 0) ' Remove os centavos do valor valor = valor - CDbl(cents) ' Passo o extenso dos centavos cents = centavos(CDbl(cents) * 100) ' End If ' Caso a string seja diferente de branco e valor seja maior ou igual a 1 If cents <> "" And valor >= 1 Then ' acrescentar uma vírgula antes do extenso cents = " e " & cents End If ' Iniciar o processo de conversao dos valores longos strMoeda = Trim(Trilhoes(valor)) & strMoeda & cents strMoeda = Replace(strMoeda, ", e", " e") strMoeda = Replace(strMoeda, ", r", " r") If Left(strMoeda, 2) = "e " Then strMoeda = Mid(strMoeda, 3, Len(strMoeda)) 'ElseIf Left(strMoeda, 5) = "mil e" Then ' strMoeda = Mid(strMoeda, 5, Len(strMoeda)) End If Extenso_Valor = strMoeda End Function Private Function centavos(valor As Double) As String Dim dezena As Integer Dim unidade As Integer ' Passa o valor para base decimal valor = Round(CDbl(valor / 100), 2) ' Se for um centavo, escrever valor e sair da funcao If valor = 0.01 Then centavos = "um centavo" Exit Function End If ' Repassa valor para dezenas valor = valor * 100 ' Se não houver dezenas no valor passado If dezenas(valor) = "" Then ' a string centavos fica em branco centavos = "" Else ' caso contrário, passar extenso das dezenas e concatenar ' com a palavra centavos centavos = dezenas(valor) & " centavos" End If End Function Private Function unidades(unidade As Double) As String Dim unid(9) ' Define as unidades a serem usadas unid(1) = "um": unid(6) = "seis" unid(2) = "dois": unid(7) = "sete" unid(3) = "três": unid(8) = "oito" unid(4) = "quatro": unid(9) = "nove" unid(5) = "cinco" ' Retorna a string referente a unidade passada para ' esta funcao unidades = Trim(unid(unidade)) End Function Private Function dezenas(dezena As Double) As String Dim dezes(9) Dim dez(9) Dim intDezena As Double Dim intUnidade As Double Dim tmpStr As String ' Define as dezenas a serem utilizadas dezes(1) = "onze": dezes(6) = "dezesseis" dezes(2) = "doze": dezes(7) = "dezessete" dezes(3) = "treze": dezes(8) = "dezoito" dezes(4) = "quatorze": dezes(9) = "dezenove" dezes(5) = "quinze" dez(1) = "dez": dez(6) = "sessenta" dez(2) = "vinte": dez(7) = "setenta" dez(3) = "trinta": dez(8) = "oitenta" dez(4) = "quarenta": dez(9) = "noventa" dez(5) = "cinqüenta" ' Calcula o inteiro da dezena intDezena = Int(dezena / 10) ' Calcula o inteiro da unidade intUnidade = dezena Mod 10 ' Se o inteiro da dezena for zero If intDezena = 0 Then ' dezenas sao iguais as unidades dezenas = unidades(intUnidade) Exit Function Else: ' caso contrário, é igual a dez dezenas = dez(intDezena) End If ' Se o inteiro da dezena for igual a 1 e ' o inteiro da unidade for zero, os valores estão ' entre 11 e 19 If (intDezena = 1 And intUnidade > 0) Then dezenas = dezes(intUnidade) Else ' Caso contrário, valor está entre 20 e 90 inclusive If (intDezena > 1 And intUnidade > 0) Then ' Concatena a string da dezena com a string da unidade dezenas = dezenas & " e " & unidades(intUnidade) End If End If dezenas = dezenas End Function Private Function centenas(centena As Double) As String Dim tmpCento As Double Dim tmpDez As Double Dim tmpUni As Double Dim tmpUniMod As Double Dim tmpModDez As Double Dim centoString As String Dim cento(9) ' Define as centenas cento(1) = "cento": cento(6) = "seiscentos" cento(2) = "duzentos": cento(7) = "setecentos" cento(3) = "trezentos": cento(8) = "oitocentos" cento(4) = "quatrocentos": cento(9) = "novecentos" cento(5) = "quinhentos" ' Calcula o inteiro da centena tmpCento = Int(centena / 100) ' Calcula a parte da dezena tmpDez = centena - (tmpCento * 100) ' Calcula o inteiro da unidade tmpUni = Int(tmpDez / 10) ' Calcula o resto da unidade tmpUniMod = tmpUni Mod 10 ' Calcula o resto da dezena tmpModDez = tmpDez Mod 10 ' Se centena for cem, definir string como "cem " e sair If centena = 100 Then centoString = "cem " Else ' Caso contrário definir a string da centena centoString = cento(tmpCento) End If ' Avalia se a unidade é maior ou igual a zero, se o resto da unidade é igual ou ' maior que zero, se a dezena é maior ou igual a um e se a centena é igual ou ' maior que 1. Se forem verdadeiros; entao, adicionar " e " a string da centena If (tmpUni >= 0 And tmpUniMod >= 0 And tmpDez >= 1 And tmpCento >= 1) Then centoString = centoString & " e " End If ' Concatena a string do cento com a string da dezena centenas = Trim(centoString & dezenas(tmpDez)) End Function Private Function milhares(milhar As Double) As String Dim tmpMilhar As Double Dim tmpCento As Double Dim milString As String ' Calcula o inteiro da milhar tmpMilhar = Int(milhar / 1000) ' Calcula o cento dentro da milhar tmpCento = milhar - (tmpMilhar * 1000) ' Se milhar for zero, entao a string da milhar fica em branco If tmpMilhar = 0 Then milString = "" ' Se for igual a 1, entao ' If '(tmpMilhar = 1) Then ' string da milhar é igual a unidade e "mil" 'milString = unidades(tmpMilhar) & "um mil " ' se maior que 1 e menor que dez, string igual a unidades If (tmpMilhar >= 1 And tmpMilhar < 10) Then milString = unidades(tmpMilhar) & " mil, " ' Se for entre 10 e 100, entao string igual a dezenas ElseIf (tmpMilhar >= 10 And tmpMilhar < 100) Then milString = dezenas(tmpMilhar) & " mil, " ' Se for entre 100 e 1000, entao igual string centenas ElseIf (tmpMilhar >= 100 And tmpMilhar < 1000) Then milString = centenas(tmpMilhar) & " mil, " End If 'If tmpCento = 1 Then milString = " e " If (tmpCento >= 1 And tmpCento <= 100) Then milString = milString & "e " milhares = Trim(milString & centenas(tmpCento)) End Function Private Function milhoes(milhao As Double) As String ' Ver comentários para milhares acima Dim tmpMilhao As Double Dim tmpMilhares As Double Dim miString As String tmpMilhao = Int(milhao / 1000000) tmpMilhares = milhao - (tmpMilhao * 1000000) If tmpMilhao = 0 Then miString = "" If (tmpMilhao = 1) Then miString = unidades(tmpMilhao) & " milhão, " ElseIf (tmpMilhao > 1 And tmpMilhao < 10) Then miString = unidades(tmpMilhao) & " milhões, " ElseIf (tmpMilhao >= 10 And tmpMilhao < 100) Then miString = dezenas(tmpMilhao) & " milhões, " ElseIf (tmpMilhao >= 100 And tmpMilhao < 1000) Then miString = centenas(tmpMilhao) & " milhões, " End If If milhao = 1000000# Then miString = "um milhão de " milhoes = Trim(miString & milhares(tmpMilhares)) End Function Private Function bilhoes(bilhao As Double) As String ' Ver comentários para milhares acima Dim tmpBilhao As Double Dim tmpMilhao As Double 'Dim tmpMilhoes As Double Dim biString As String tmpBilhao = Int(bilhao / 1000000000) tmpMilhao = bilhao - (tmpBilhao * 1000000000) If (tmpBilhao = 1) Then biString = unidades(tmpBilhao) & " bilhão, " ElseIf (tmpBilhao > 1 And tmpBilhao < 10) Then biString = unidades(tmpBilhao) & " bilhões, " ElseIf (tmpBilhao >= 10 And tmpBilhao < 100) Then biString = dezenas(tmpBilhao) & " bilhões, " ElseIf (tmpBilhao >= 100 And tmpBilhao < 1000) Then biString = centenas(tmpBilhao) & " bilhões, " End If If bilhao = 1000000000# Then biString = "um bilhão de " bilhoes = Trim(biString & milhoes(tmpMilhao)) End Function Private Function Trilhoes(Trilhao As Double) As String ' Ver comentários para milhares acima Dim tmpTrilhao As Double Dim tmpBilhao As Double Dim triString As String tmpTrilhao = Int(Trilhao / 1000000000000#) tmpBilhao = Trilhao - (tmpTrilhao * 1000000000000#) If (tmpTrilhao = 1) Then triString = unidades(tmpTrilhao) & " trilhão, " ElseIf (tmpTrilhao > 1 And tmpTrilhao < 10) Then triString = unidades(tmpTrilhao) & " trilhões, " ElseIf (tmpTrilhao >= 10 And tmpTrilhao < 100) Then triString = dezenas(tmpTrilhao) & " trilhões, " ElseIf (tmpTrilhao >= 100 And tmpTrilhao < 1000) Then triString = centenas(tmpTrilhao) & " trilhões, " End If If Trilhao = 1000000000000# Then triString = "um trilhão de " Trilhoes = Trim(triString & bilhoes(tmpBilhao)) End Function Function arredBaixo(valor) Dim tmpValor tmpValor = Round(CDbl(Right(Round(valor, 2) * 100, 2)) / 100, 2) arredBaixo = Round(Round(valor, 2) - tmpValor, 0) End Function > É bem extenso, por isso estava pensando numa forma mais fácil de solucionar o problema, mas se houver outra maneira estou aberto à sugestões. obrigado A minha planilha é muito extensa, 14 módulos e muitas funções, seria difícil de definir onde realmente seria necessário atenção, vou disponibilizar uma versão simplificada modelo.rar

Bom dia! Estou utilizando uma função que transcreve números por extenso, porém preciso que esse valor fique entre "( ) " O Parentese final (à direita) eu consegui colocar, pois é fácil localizar (fica após real ou reais), porém o primeiro parentese já é mais difícil já que pode ter vários resultados Ex: 1.200,00 - Mil e Duzentos reais) 30.000,00 - Trinta Mil reais) 1.000.000,00 - Um Milhão de reais) Para solucionar esse problema pensei em fazer uma array para percorrer todos os caracteres desta célula com um contador (próximo carácter + 1), Se contador <1 adicionar "(" Mas não conseguir desenvolver esse código, somente a logica. Peço encarecidamente a ajuda de meus companheiros para resolver esta questão, *OBS: Caso seja necessário eu posso disponibilizar o código de transcrever os números por extenso, mas creio que não fará muita diferença. Desde já grato, Att,

Deu certo, valeu novamente!!!! Pra quem usar esse codigo futuramente para estudos ou para solucionar algum problema é legal limpar a seleção de copia após a ativação do comando. ( Application.CutCopyMode = False ) Para isso, deve-se coloca-la ao final da macro, dessa forma... < Sub Macro() Dim Counter As Integer Dim Inicio As Integer Dim Final As Integer For Counter = 1 To 200 Dim curCell As Range Set curCell = Worksheets("ORÇAMENTO").Cells(Counter, 1) If curCell.Value = "INICIO" Then Inicio = curCell.Row ElseIf curCell.Value = "FIM" Then Final = curCell.Row If Inicio <> 0 Then Range("A" & Inicio & ":F" & Final).Copy Worksheets("CONTRATO").Range("A19").PasteSpecial End If Inicio = 0 End If Next Counter Application.CutCopyMode = False End Sub >

@Midori Então, o código completo está ai, acima do for seria o inicio da sub. Declaro como Integer? Dim Inicio As Integer Dim Final As Integer E na Range eu faria como? Range("A" & Inicio : "B" & Final).Copy Estou perdido rsrsrrsrsr, nem sei se meu codigo está transmitindo a logica do que pretendo fazer.

Bom dia! Sei que parece besteria, mas ainda estou me adaptando com o VBA, Tenho um código bem simples, a função dele é percorrer as linhas da coluna a da Sheet "ORÇAAMENTO" e verificar o resultado "INICIO", se encontrado, guardar o numero da linha na variavel Inicio. O mesmo para a palavra "FIM", guardar o numero da linha na variavel "Final" Daí pretendo criar um período "A" Inicio até "F" Final e copia-los. Esse resultado vou colar na Sheet CONTRATO posição "A16". Esse é meu codigo: < For Counter = 1 To 200 Set curCell = Worksheets("ORÇAMENTO").Cells(Counter, 1) If curCell.Value = "INICIO" Then Inicio.Value = contaLinha.Row If curCell.Value = "FIM" Then Final.Value = contaLinha.Row Range("A & Inicio : B & Final").Copy Worksheets("CONTRATO").Range("A16").PasteSpecial Next Counter > Aparece p erro '1004 - O método Range do Objeto Global Falhou Onde estou errando? Desde já Grato!!!

Bom dia! Sei que parece besteria, mas ainda estou me adaptando com o VBA, Tenho um código bem simples, a função dele é percorrer as linhas da coluna a da Sheet "ORÇAAMENTO" e verificar o resultado "INICIO", se encontrado, guardar o numero da linha na variavel Inicio. O mesmo para a palavra "FIM", guardar o numero da linha na variavel "Final" Daí pretendo criar um período "A" Inicio até "F" Final e copia-los. Esse resultado vou colar na Sheet CONTRATO posição "A16". Esse é meu codigo: < For Counter = 1 To 200 Set curCell = Worksheets("ORÇAMENTO").Cells(Counter, 1) If curCell.Value = "INICIO" Then Inicio.Value = contaLinha.Row If curCell.Value = "FIM" Then Final.Value = contaLinha.Row Range("A & Inicio : B & Final").Copy Worksheets("CONTRATO").Range("A16").PasteSpecial Next Counter > Aparece p erro '1004 - O método Range do Objeto Global Falhou Onde estou errando? Desde já Grato!!!

@Midori Funcionou sim !!! Novamente me salvando, sou muito grato.

@Midori Seria uma possibilidade se onde encontrar "AQUI" fosse fixo, porém na tabela original, essa soma total é inserida somente após a finalização do orçamento por meio de um botao (Finalizar Orçamento) que está associada a outras macros. Como no meu caso essa celula nunca será fixa eu teria que fazer uma função no VBA mesmo. Se tiver outra forma de fazer isso é só me corrigir, se necessário eu posso disponibilizar minha planilha apenas para voce entender a logica.

Boa Tarde Pessoal !!!, Gostaria de somar todas as células que estão ao lado (Na mesma linha que...) de onde estiver escrito exatamente: "VALOR TOTAL DO ITEM:" Foi a unica maneira que consegui pensar para verificar onde está este resultado que já é o produto da soma de outros items, pois a localização das linhas não serão fixas e a quantidade de somas também não. "VALOR TOTAL DO ITEM:" - Estará localizado na coluna D O Resultado da soma - Estará localizado na coluna E ("AQUI") Para melhor entendimento irei disponibilizar imagens de uma planilha simplificada do meu projeto. Caso alguém encontre outra forma de localizar exatamente onde estão esses itens, estou aberto a opções. Desde Já Grato! Teste.rar