locked
Macro para executar um for

    Question

  • Pessoal boa tarde!
    Estou com dificuldade para criar uma macro que execute o seguinte procedimento:

    Sub Teste()
     
        Range("M1").Select
        Selection.Copy
        Range("G2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("O1").Select
        Selection.Copy
        Range("N1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
       End Sub


    No entanto este procedimeto que é simples tem que ser executado para cada valor  que esta na coluna M .

    Então o Range tem que variar de "M1" Até o fim dos valores na coluna e o "N1" tambem tem que varia de acordo com o M ou seja para M1 tem que ser N1 e para M2 ten que ser N2.


    Na verdade este script copia um valor joga em uma coluna onde eu executo uma operação então a resposta eu copio e colo em uma outra coluna.

    O meu problema principal é dado uma coluna com diversos codigos tenho que achar o valor maximo para cada codigo. Usei a função BD assim :
    =BDMÁX($A$1:$D$45;"QDE";$G$1:$G$2)  então para cada valor de uma coluna tenho que achar o maximo e retornar na frente do codigo em outra coluna! Esta funcionando bem mas apenas em uma celula por isso quero a macro que copia um valor cola nesta coluna e depis copia o resultado para outro lugar e isso até o fim dos valores da coluna m..

    Bom se alguem souber um caminho mais facil ou souber como fazer o for por favor me ajude!
    Monday, October 09, 2006 3:07 PM

Answers

  • Flávio,

    agora entendi.

    levando em conta que os codigos estao na coluna A e os valores na coluna B. Na coluna D ficará o codigo e na coluna E o maior numero.

    Espero ter ajudado!

    []'s e tente isto!


    Sub Separa_maiores_main()
    Dim Linha As Long
    Dim Codigo As Long
    Dim Maior As Long
    Dim LinhaDestino As Long

        ' classifica os códigos por ordem crescente
        Columns("A:B").Select
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        Range("A2").Select
        LinhaDestino = 2
        Linha = 2
        'percorrendo a coluna de códigos
        While Cells(Linha, 1) <> ""
            Codigo = Cells(Linha, 1).Value 'pega o codigo atual
            Maior = busca_o_maior(Codigo, Linha) ' busca o maior
            Call registra(Codigo, Maior, LinhaDestino) ' registra o maior em outra tabela
        Wend
       
    End Sub

    'Buscando o maior
    Function busca_o_maior(ByVal Codigo As Long, ByRef Linha As Long) As Long
    Dim Valor As Long
    Valor = 0
        While Cells(Linha, 1).Value = Codigo 'enquanto for igual ao código faça
            If Cells(Linha, 2).Value > Valor Then 'compara o valor
                Valor = Cells(Linha, 2).Value 'pega o maior valor
            End If
        Linha = Linha + 1
        Wend
        busca_o_maior = Valor 'devolve o maior valor do codigo
    End Function
     Sub registra(ByVal Codigo As Long, ByVal Maior As Long, ByRef LinhaDestino As Long)
        'apenas coloca o dado em uma tabela separada
        Range("d" & LinhaDestino) = Codigo
        Range("e" & LinhaDestino) = Maior
        LinhaDestino = LinhaDestino + 1
     End Sub

    Monday, October 09, 2006 6:03 PM
  • Flávio,

    Se as condições são as mesmas não era para dar problema não. Tem que ver que tipo de erro gerou em outra máquina.

    Quanto a trocar as colunas vc precisa verificar o codigo e substituir as seguintes expressões:

        Columns("A:B").Select

        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

        Cells(Linha, 1) >> onde 1 equivale a primeira coluna, 2 a segunda, e assim por diante.

     

    Se for trocar o destino, basta mudar no "registra".

    Espero ter ajudado!

    []'s

    Monday, October 09, 2006 7:08 PM

All replies

  • Flávio,

    não sei se entendi bem.. Vamos dividir isto em partes para facilitar o entendimento e a solução.

    Pelo que entendi vc tem que:

    1 - copiar e colar valores da coluna M na coluna G. Para cada linha da coluna M que contiver valor, vc quer passar o valor desta célula para a linha imediatamente posterior só que na coluna G. Exemplo: valor de M1 irá para G2, valor de M2 irá para G3 e assim por diante.. entendi?

    2 - copiar e colar valores da coluna O na coluna N. Para cada linha da coluna O que contiver valor, vc quer passar o valor desta célula para a mesma linha  na coluna N. Exemplo: valor de O1 irá para N1, valor de O2 irá para N2 e assim por diante.. entendi?

    3 - pergunta: isto tem que ser intercalado, hora executo o passo 1 e depois o passo 2?

    4 - Não entendi a parte do valor máximo para cada código...

    Fico no aguardo para tentar ajudar.

    Monday, October 09, 2006 5:16 PM
  • Na verdade o que eu preciso é pegar o valor maximo de uma ocorrencia para um determinado codigo. exe
    A                      B                     C              D
                                                                    
    Codigo          Valor               Codigo       Resultado    
    1                       5                      1                  10
    1                       10                     2                  5
    1                        3                      3                  6
    2                        1
    2                        5
    3                        1
    3                         6

    Eu consegui isso para um codigo usando a função BDMAX. Mas so consegui aplicar para uma unica linha quando tento aplicar para as outras ele sempre pega o mesmo codigo. Então pensei em usar um "for" para ir fazendo automaticamete a alimetação dessa unica linhae colando o valor na coluna na ordem certa. Não é necessário fazer assim o problema  principal é saber o valor maximo de cada codigo. como no exemplo que eu citei. Se vc souber fazer de outra maneira agradeço demais!
    Monday, October 09, 2006 5:30 PM
  • Flávio,

    agora entendi.

    levando em conta que os codigos estao na coluna A e os valores na coluna B. Na coluna D ficará o codigo e na coluna E o maior numero.

    Espero ter ajudado!

    []'s e tente isto!


    Sub Separa_maiores_main()
    Dim Linha As Long
    Dim Codigo As Long
    Dim Maior As Long
    Dim LinhaDestino As Long

        ' classifica os códigos por ordem crescente
        Columns("A:B").Select
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        Range("A2").Select
        LinhaDestino = 2
        Linha = 2
        'percorrendo a coluna de códigos
        While Cells(Linha, 1) <> ""
            Codigo = Cells(Linha, 1).Value 'pega o codigo atual
            Maior = busca_o_maior(Codigo, Linha) ' busca o maior
            Call registra(Codigo, Maior, LinhaDestino) ' registra o maior em outra tabela
        Wend
       
    End Sub

    'Buscando o maior
    Function busca_o_maior(ByVal Codigo As Long, ByRef Linha As Long) As Long
    Dim Valor As Long
    Valor = 0
        While Cells(Linha, 1).Value = Codigo 'enquanto for igual ao código faça
            If Cells(Linha, 2).Value > Valor Then 'compara o valor
                Valor = Cells(Linha, 2).Value 'pega o maior valor
            End If
        Linha = Linha + 1
        Wend
        busca_o_maior = Valor 'devolve o maior valor do codigo
    End Function
     Sub registra(ByVal Codigo As Long, ByVal Maior As Long, ByRef LinhaDestino As Long)
        'apenas coloca o dado em uma tabela separada
        Range("d" & LinhaDestino) = Codigo
        Range("e" & LinhaDestino) = Maior
        LinhaDestino = LinhaDestino + 1
     End Sub

    Monday, October 09, 2006 6:03 PM
  • Obrigado amigo!
    como faço para alterar as colunas tipo Codigo coluna B e quantidade D?
    O arquivo funcionou apenas na minha maquina você sabe por que? en outra maquina da erro
    bem aqui!
    While Cells(Linha, 1) <> ""
            Codigo = Cells(Linha, 1).Value 'pega o codigo atual
            Maior = busca_o_maior(Codigo, Linha) ' busca o maior
            Call registra(Codigo, Maior, LinhaDestino) ' registra o maior em outra tabela
        Wend
    Monday, October 09, 2006 7:03 PM
  • Flávio,

    Se as condições são as mesmas não era para dar problema não. Tem que ver que tipo de erro gerou em outra máquina.

    Quanto a trocar as colunas vc precisa verificar o codigo e substituir as seguintes expressões:

        Columns("A:B").Select

        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

        Cells(Linha, 1) >> onde 1 equivale a primeira coluna, 2 a segunda, e assim por diante.

     

    Se for trocar o destino, basta mudar no "registra".

    Espero ter ajudado!

    []'s

    Monday, October 09, 2006 7:08 PM