Fazer um loop até terminar as células.

Tabela e gráficos dinâmicos!

Fazer um loop até terminar as células.

Mensagempor advogado » Seg Jan 27, 2020 4:32 pm

tem como transformar esse VBA em fórmula?

Eu mesmo que fiz esse código:

Código: Selecionar todos
Sub frente()
'
' frente Macro
'
' Atalho do teclado: Ctrl+f
'
coluna = 3
conteudo = Cells(6, 2)
Do Until Cells(6, coluna) = ""

    conteudo = conteudo & ";" & Cells(6, coluna)
    coluna = coluna + 1
   
    Loop
    Cells(10, 2) = conteudo
End Sub

O problema é que eu não queria ter que dar comando para executar. Gostaria que fosse automaticamente
advogado
Membro
Membro
 
Mensagens: 17
Registrado em: Qui Mar 12, 2015 2:12 pm
Has thanked: 4 times
Have thanks: 8 times

{ SO_SELECT }

Re: Fazer um loop até terminar as células.

Mensagempor wagner » Ter Jan 28, 2020 9:02 am

advogado,

Bom dia!

Para ficar automático, toda vez que você inserir um valor em qualquer coluna da linha 6, basta inserir o código abaixo no evento Worksheet_Change da aba que você quer:
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    'Já deixe a célula B10 carregada com o valor de B6. Basta inserir em B10 a fórmula = B6
    If Target.Count > 1 Then
        Application.EnableEvents = True
        Exit Sub
    End If
   
    If Target.Row = 6 And Target.Column >= 3 Then
        Range("B10").Value = Range("B10").Value & ";" & Cells(6, Target.Column).Value
    End If
    Application.EnableEvents = True
End Sub
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 5547
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 104 times
Have thanks: 2373 times

Re: Fazer um loop até terminar as células.

Mensagempor advogado » Ter Jan 28, 2020 3:59 pm

acho que você não entendeu. não é só o valor de uma célula.

essa fórmula faz a concatenação de várias células dentro da linha 6 de forma dinâmica até a célula estar vazia.

pode ser da célula B6 até a E6 ou até a AG6, o número de colunas é variável.

eu vou disponibilizar a tabela daí você vê melhor.
https://www.4shared.com/office/ffsw_ghMiq/pginas.html

Ela organiza as páginas para você imprimir fascículos de um livro, por exemplo, um livro de 136 páginas, você vai pedir primeiro da página 1 até a 32 para formar o primeiro fascículo, depois da 33 até a 64 para formar o segundo, da 65 até a 96 e, por fim, o último fascículo da página 97 até a 136, formando um fascículo maior, ou mais um fascículo da página 97 até 128 e o último fascículo da 129 até a 136, formando um fascículo menor.

eu tenho que executar a macro para dar os valores, todos juntos na mesma célula. Eu gostaria que os valores fossem calculados automaticamente sem precisar executar a macro.
advogado
Membro
Membro
 
Mensagens: 17
Registrado em: Qui Mar 12, 2015 2:12 pm
Has thanked: 4 times
Have thanks: 8 times

Re: Fazer um loop até terminar as células.

Mensagempor EdsonBR » Qua Jan 29, 2020 9:20 am

Bom dia, @advogado, bom dia @wagner

Vc quer uma concatenação à direita desde uma célula inicial até a primeira célula vazia e usando como delimitador o ponto-e-vírgula, é isso?
Tente usar uma UDF como a seguir:

Código: Selecionar todos
Function ConcatPágs(célIni As Range) As String
   Do Until célIni.Value = ""
     ConcatPágs = ConcatPágs & célIni.Value & ";"
     Set célIni = célIni.Offset(0, 1)
   Loop
   If ConcatPágs <> vbNullString Then ConcatPágs = Left(ConcatPágs, Len(ConcatPágs) - 1)
End Function

Use-a como uma fórmula normal do Excel. Por exemplo:
Na célula B10 insira:
Código: Selecionar todos
=ConcatPágs(B6)

e assim por diante.
Imagem
Avatar do usuário
EdsonBR
Membro
Membro
 
Mensagens: 677
Registrado em: Qui Nov 05, 2015 11:43 pm
Localização: Joinville, SC
Has thanked: 148 times
Have thanks: 444 times


Voltar para Tabela Dinâmica

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 1 visitante