Notifications
Clear all

Multiplicar linhas de uma coluna por um valor constante

5 Posts
3 Usuários
0 Reactions
1,127 Visualizações
(@jorgeedu)
Posts: 0
New Member
Topic starter
 

Boas Noites

Sou novato no VBA, e ainda ando as cabeçadas a aprender, e por isso vim pedir uma ajudinha que creio que seja bem facil.

Tenho o seguinte código:
------

Sub insertrows()
'Duplica "x" vezes cada uma das linhas na tabela

    Dim I As Long
    Dim xCount As Integer
LableNumber:
    xCount = Application.InputBox("Quantas vezes quer multiplicar as linhas?", , , , , , , 1)
    If xCount < 1 Then
        MsgBox "Erro, o valor não é valodo, intruduza novamente"
        GoTo LableNumber
    End If
    For I = Range("A" & Rows.CountLarge).End(xlUp).Row To 1 Step -1
        Rows(I).Copy
        Rows(I).Resize(xCount).Insert
    Next
    Application.CutCopyMode = False
End Sub

Ele faz exactamente o que preciso na maioria dos casos, mas agora tenho uma situação que tenho que sempre "multiplicar" os dados por um valor constante
numa tabela, supúnhamos que por 34, e não queria que a caixa de mensagem me aparecesse e tivesse que escrever o numero de vezes que preciso multiplicar, neste caso 34.
Já vi algumas soluções de o código ir buscar o valor a uma célula, mas não era o que eu queira.

Alguém consegue dar-me uma ajuda.

Muito obrigado

 
Postado : 05/07/2018 8:22 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Jorgeedu,

Bom dia!

Seja muito bem vindo ao fórum.

Para aproveitar ao máximo o fórum e sempre manter o mesmo de forma organizada, sugiro ler os tópico da regras abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Algumas solicitações especiais que pedimos, por gentileza, ficar atento:
1 - Não inserir no titulo de suas postagens expressões como Help, Ajuda, etc. O título deve ser um resumo da sua necessidade para que outras pessoas que tenham a mesma dúvida possam efetuar a pesquisa e achar como foi resolvido.
2 - Não insira em suas mensagens frases todas escritas em letras maiúsculas. Isso, na Internet, é compreendido como gritos e muitos usuários sequer respondem somente por esse fato!
3 - Insira sempre um arquivo exemplo compactado com .ZIP aqui mesmo no fórum. Existe, logo abaixo da caixa de mensagens, uma aba chamada "Adicionar um anexo" para essa finalidade. O arquivo exemplo deve ser pequeno, com apenas 5 linhas no máximo, compactado com .ZIP e ter o mesmo layout (nome do arquivo, nome das abas/guias/folhas, mesma linha/coluna onde os dados se iniciam) do arquivo original. Links de arquivos enviados para sites de compartilhamento de arquivos, muitas vezes são bloqueados pelas empresas, por conterem muitos vírus. Alguns usuários que acessam o fórum a partir de empresas não conseguem baixar tais arquivos.
4 - Não utilize a ferramenta CITAR para inserir o inteiro teor das mensagens que lhe são encaminhadas como resposta. Citações, se estritamente necessárias ao entendimento da mensagem que você quer enviar, devem ser apenas de pequenos trechos das mensagens.
5 - Se for postar códigos VBA aqui no fórum, utilize a ferramenta CODE localizada logo no início da caixa de mensagens (quinto botão da esquerda para a direita). As linhas de código devem ficar entre as palavras "CODE e /CODE".
6 - Agradeça sempre às pessoas que lhe responderam e às mensagens que atenderam a necessidade de sua demanda. Esse agradecimento deve ser clicando na mãozinha que fica localizada ao lado da ferramenta CITAR. Lembre-se: o fórum é gratuito e esse é o único incentivo para as pessoas que prestam ajuda. Você pode agradecer a quantos usuários quiser.
7 - O título ou o texto das mensagens postadas não devem ser escritos todo em letras maiúsculas. Na internet, tudo escrito em letras maiúsculas é interpretado como gritos e muitos usuários sequer olham para esse tipo de mensagem.

Quanto a sua demanda, confesso que não entendi muito bem o que de fato você quer. Mas... se for apenas pegar o valor de uma célula para multiplicar por outro valor de outra célula, o código é bem simples. Vamos supor que o valor que será multiplicado está na célula B3, que a quantidade de vezes que será multiplicado (no seu exemplo = 34) está na célula D3 e que o resultado da multiplicação deverá ser inserido na coluna C, a partir da linha 3. Desse modo, você poderia usar o código abaixo para fazer a multiplicação:

Sub Multiplicar()
     Dim i as long
     Dim Linha as long

     Linha = 3
     For i = 1 to Clng(Range("D3").Value)
          Range("C"" & Linha).Value = Range("B3").Value * i
          Linha = Linha +1
     Next
End Sub
 
Postado : 06/07/2018 7:34 am
(@jorgeedu)
Posts: 0
New Member
Topic starter
 

Caro Wagner,

Muito obrigado pela sua resposta.
Julgo que não me expressei da melhor forma.
Então é o seguinte:
O que eu tenho é a coluna "Original" e o que pretendo obter é a coluna "Resultado".
O Código que postei, faz exactamente isso, quando o corro ele abre uma janela e pergunta-me quantas vezes eu quero "replicar", neste caso seria por 2 para poder obter 3 resultados de cada, já que os dados de inicio estão na A1 e o resultado também aparece na A1 (se correr o código vai entender).
Ora bem, acontece que eu agora recebo um monte de ficheiros em que eles precisam ser copiados ou replicados sempre pelo mesmo valor para que eu obtenha as tais 34 de cada.
Como faço isso de uma forma corrida com atalhos eu precisava que no código já tivesse essa informação de "replicar" por 34 para que não me aparece a janela e eu tenha de escrever o numero.

A solução que que me apresentou, eu já a havia testado e isso implicaria que em cada ficheiro eu tivesse que escrever o numero, para que ele soubesse. Por isso no meu post anterior eu especifiquei que já conhecia mas não era o que queria. Alem disso espero passar para outra pessoa ,que passará a fazer isso, e sabe como é, facilmente apaga o que não deve e lá vem o problema.

Isso é possível ?

Original
A
B
C

Resultado
A
A
A
B
B
B
C
C
C

 
Postado : 06/07/2018 11:50 am
(@klarc28)
Posts: 0
New Member
 
Sub insertrows()
'Duplica "x" vezes cada uma das linhas na tabela

    Dim I As Long
    Dim xCount As Integer
LableNumber:
    xCount = 34
    If xCount < 1 Then
        MsgBox "Erro, o valor não é valodo, intruduza novamente"
        GoTo LableNumber
    End If
    For I = Range("A" & Rows.CountLarge).End(xlUp).Row To 1 Step -1
        Rows(I).Copy
        Rows(I).Resize(xCount).Insert
    Next
    Application.CutCopyMode = False
End Sub
 
Postado : 07/07/2018 8:17 am
(@jorgeedu)
Posts: 0
New Member
Topic starter
 

Boas noites, klarc28

É isso mesmo, muito obrigado.
Não consegui de forma alguma lembrar me disso.

:D :D

 
Postado : 07/07/2018 5:22 pm