Este fórum está sendo desativado

[jorge24]

olá,

Preciso de uma ajuda com um código VBA.

Preciso que ao inserir um número na célula "F" as células dessa linha sejam repetidas para as linhas abaixo esse determinado numero de vezes.

Ou seja, se colocar na célula "F" o numero 20, automaticamente são preenchidas 20 linhas com os valores da linha original.

Será que alguém me pode dar uma ajuda. obrigado

[Jimmy]

Olá Jorge,

Coloque a macro abaixo no evento CHANGE da planilha em questão.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Qtd = Target.Value
        Lin = Target.Row
        If IsNumeric(Qtd) Then
            Even = Application.EnableEvents
            Application.EnableEvents = False
            Range(Cells(Lin, 1), Cells(Lin, 14)).Copy
            Range(Cells(Lin, 1), Cells(Lin + Qtd - 1, 14)).Select: ActiveSheet.Paste
            If Qtd > 1 Then
                Cells(Lin, 7).Select:   Selection.Value = 1
                Selection.AutoFill Destination:=Range(Cells(Lin, 7), Cells(Lin + Qtd - 1, 7)), Type:=xlFillSeries
            End If
            Target.Select
        End If
        Application.EnableEvents = Even
    End If
End Sub

Se der algo errado, me avise.

Jimmy San Juan

[osvaldomp]

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Column <> 6 Then Exit Sub
 On Error Resume Next
 Cells(Target.Row, 1).Resize(, 14).Copy Cells(Target.Row + 1, 1).Resize(Target.Value, 14)
End Sub

[jorge24]

Olá,

antes de mais quero agradecer aos companheiros que responderam.

A rotina do companheiro jimmy é mais completa pois enumera por ordem decrescente todas as prestações no entanto queria saber se é possivel que as datas avançassem um mês em cada prestação?

Encontrei algumas coisas no youtube mas não tenho conhecimentos suficientes para adaptar.

Esta rotina foi criada pelo companheiro Alessandro Trovato. É bastante completa mas não sei adaptar à minha planilha.

Código: Selecionar todos

Option Explicit

Private Sub btExecuta_Click()

Dim W           As Worksheet
Dim UltCel      As Range
Dim vCartao     As String
Dim vDataVenda  As Date
Dim vParcelas   As Integer
Dim vValorTotal As Currency

Dim Ln          As Long
Dim Col         As Integer

Dim TransfLn    As Long
Dim TransfCol   As Integer

Dim A           As Integer
Dim VerDif      As Currency

Set W = Sheets("Plan1")
W.Select

W.Range("A2").Select

Set UltCel = W.Cells(W.Rows.Count, 1).End(xlUp)

Ln = 2
Col = 1
TransfLn = 2
TransfCol = 7

W.Range("G:J").EntireColumn.Delete

Do While ActiveCell.Row <= UltCel.Row

    VerDif = 0
    vCartao = W.Cells(Ln, Col).Value
    vDataVenda = W.Cells(Ln, Col + 1).Value
    vParcelas = W.Cells(Ln, Col + 2).Value
    vValorTotal = W.Cells(Ln, Col + 3).Value
    
    For A = 1 To vParcelas
    
        W.Cells(TransfLn, TransfCol).Value = vCartao
        W.Cells(TransfLn, TransfCol + 1).Value = "Parcela " & A
        W.Cells(TransfLn, TransfCol + 2).Value = vDataVenda + (A * 30)
        W.Cells(TransfLn, TransfCol + 3).Value = _
             Application.WorksheetFunction.Round(vValorTotal / vParcelas, 2)
        
        VerDif = VerDif + W.Cells(TransfLn, TransfCol + 3).Value
        
        TransfLn = TransfLn + 1
    
    Next A
    
    'Checar valor total da venda
    If VerDif < vValorTotal Then
        W.Cells(TransfLn - 1, TransfCol + 3).Value = _
            W.Cells(TransfLn - 1, TransfCol + 3).Value _
            + (vValorTotal - VerDif)
    ElseIf VerDif > vValorTotal Then
        W.Cells(TransfLn - 1, TransfCol + 3).Value = _
            W.Cells(TransfLn - 1, TransfCol + 3).Value _
            - (VerDif - vValorTotal)
    End If

    ActiveCell.Offset(1, 0).Select
    Ln = Ln + 1

Loop

W.Range("A1:D1").Copy Destination:=W.Range("G1")
W.Range("g2").CurrentRegion.EntireColumn.AutoFit

MsgBox "Processo concluído"
W.Range("A1").Select

End Sub

Obrigado

[Jimmy]

Olá Jorge,

... enumera por ordem decrescente todas as prestações...

Ordem decrescente? Era pra ser decrescente? Eu fiz crescente.

Vou ver a questão da data.

[jorge24]

Olá,

Obrigado pela resposta.

Tem razão está por ordem crescente e está bem assim!!!

Na questão da data se puder dá uma ajuda... Obrigado

[Jimmy]

Jorge,

Substitua a macro anterior por esta, e teste.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F:F")) Is Nothing Then
        Qtd = Target.Value
        Lin = Target.Row
        If IsNumeric(Qtd) Then
            Even = Application.EnableEvents
            Application.EnableEvents = False
            Range(Cells(Lin, 1), Cells(Lin, 14)).Copy
            Range(Cells(Lin, 1), Cells(Lin + Qtd - 1, 14)).Select: ActiveSheet.Paste
            Application.EnableEvents = Even
            If Qtd > 1 Then
                Cells(Lin, 7).Value = 1
                Cells(Lin, 7).AutoFill Destination:=Range(Cells(Lin, 7), Cells(Lin + Qtd - 1, 7)), Type:=xlFillSeries
                Data = Cells(Lin, 11).Value
                Cells(Lin + 1, 11).Value = DateSerial(Year(Data), Month(Data) + 1, Day(Data))
            End If
            If Qtd > 2 Then
                Range(Cells(Lin, 11), Cells(Lin + 1, 11)).AutoFill Destination:= _
                Range(Cells(Lin, 11), Cells(Lin + Qtd - 1, 11))
            End If
            Target.Select
        End If
    End If

End Sub

[SandroLima]

Está apontando variável não declarada.

[Jimmy]

Por acaso você incluiu a declaração Option Explicit ou incluiu alguma macro que tivesse essa declaração?

[SandroLima]

Era isso, Jimmy.

Estou aprendendo ainda

Obrigado.

[Jimmy]

Essa declaração é recomendada por muitos desenvolvedores de VBA.
Se quiser mantê-la, você deve declarar TODAS as variáveis que foram usadas usando o DIM.
Para projetos pequenos como este nosso, EU acho que ela perturba mais do que ajuda, e não uso. Muitos defendem utilizar sempre.

O mais importante: a macro atualizou a data da forma esperada?

[Jimmy]

OPS...... agora fiquei confuso.

O tópico é do @jorge24, mas deu erro para o @SandroLima ??

[SandroLima]

Estava só acompanhando a rotina solicitada pelo colega. É do meu interesse também, Jimmy.

E sobre sua pergunta... o código funciona perfeitamente... atualiza a data de forma esperada

Aproveitando o gancho de declarar ou não variáveis... Tenho esse código para ordenar uma tabela salvo em um módulo.

Código: Selecionar todos

Option Explicit

Sub OrdenaTabela()

    Dim TabelaAtividades As ListObject 
    
    Set TabelaAtividades = wshAtividadesDiarias.ListObjects("TB_AtividadesDiarias")
    
    With TabelaAtividades.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("TB_AtividadesDiarias[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
...
...
...
    
    TabelaAtividades.Sort.SortFields.Clear
    
    Set TabelaAtividades = Nothing
        
End Sub

Pretendo utilizar ele dentro de outras macros através da comando Call OrdenaTabela

A dúvida é a seguinte:
Na pasta de trabalho, e nessa planilha em questão, a tabela é sempre a mesma...
Devo declarar as variáveis e fazer o "set" da tabela no início da página de código da planilha em questão?
Ou deveria deixar na sub OrdenaTabela() (que se encontra em um módulo) e para isso eu deveria remover as variáveis e o "set" da página de código da planilha e manter somente no módulo? Qual a opção mais adequada?

[SandroLima]

Desculpem-me a intromissão no código do colega se for inconveniente.

A declaração Option Explicit estava inclusa no módulo e pensei que poderia estar acontecendo com mais alguém também.

Podem retomar o tópico.

Desculpem-me mais uma vez.

[Jimmy]

Sandro, difícil responder sua pergunta sem ver a planilha. Há também questões que não são tão técnicas mas mais pessoais, de como o desenvolvedor prefere organizar seu trabalho. Como eu te falei, não costumo usar o OPTION EXPLICIT.

O definição do SET, muitas vezes, não tem indicação técnica, mas encurta linhas e torna o código mais limpo.

O código que você publicou ficaria assim sem o SET:

With wshAtividadesDiarias.ListObjects("TB_AtividadesDiarias").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("TB_AtividadesDiarias[[#All],[Data]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
...
...
...

wshAtividadesDiarias.ListObjects("TB_AtividadesDiarias").Sort.SortFields.Clear



mas funcionaria. Agora imagine que você esteja usando-o em 100 ou 500 locais do sistema!
Imagine que tenha que trocar uma letra nele! Em vez de trocar no SET, teria que trocar em todas as ocorrências! Mais difícil e sujeito a erros.

Não sei se te ajudei ou confundi...

[SandroLima]

Entendido.

[jorge24]

Obrigado a todos mas, em especial ao Jimmy pela ajuda preciosa.

Muito grato, abraço