Jump to content
Fórum Script Brasil
  • 0

Valores não estão sendo inseridos nas células


asafe_

Question

Tenho uma base de dados correspondente a um dia, ao atualizar preciso dos mesmos valores 30 vezes completando 31 dias que é o máximo de dias em um mês apenas fazendo um incremento (+1) para criar a base de dados do mês todo. Alguém tem alguma sugestão?

Aqui uma cópia do código.

Sub copiarDados()

    ' Desativar atualização de tela e ativar cálculo manual

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    

    On Error GoTo ErrorHandler

    

    Dim ws As Worksheet

    Set ws = ThisWorkbook.ActiveSheet

    

    Dim rngDados As Range

    Dim rngData As Range

    Dim celDataInicial As Range

    Dim i As Integer

    

    'Selecionar o range total de dados a partir do intervalo nomeado "linha_inicial"

    Set rngDados = ws.Range("linha_inicial").Resize(ws.Cells(ws.Rows.Count, ws.Range("linha_inicial").Column).End(xlUp).Row - ws.Range("linha_inicial").Row + 1)

    If rngDados Is Nothing Then Exit Sub

    

    'Identificar a coluna de data como a terceira coluna do intervalo de dados

    Set rngData = rngDados.Columns(3)

    

    'Selecionar a célula com a data inicial como a primeira célula da coluna de data

    Set celDataInicial = rngData.Cells(1)

    

    ' Calcular a quantidade de dias no mês da data inicial

    Dim quantidadeDias As Integer

    quantidadeDias = Day(DateSerial(Year(celDataInicial.Value), Month(celDataInicial.Value), 0))

    

    ' Calcular o número de linhas a serem inseridas (dias do mês menos um, pois o dia 1 já está no intervalo inicial de dados)

    Dim numRows As Integer

    numRows = quantidadeDias - 1

    

    ' Armazenar referência da célula inicial

    Dim celInicialOriginal As Range

    Set celInicialOriginal = celDataInicial

    

    'Loop para adicionar as cópias dos dados abaixo

    For i = 1 To numRows

        ' Armazenar dados em uma matriz

        Dim dataValues As Variant

        dataValues = rngData.Value

        

        ' Ajustar os dados na matriz

        Dim j As Integer

        For j = LBound(dataValues, 1) To UBound(dataValues, 1)

            If j = 1 Then

                ' Incrementar a data inicial

                dataValues(j, 1) = celDataInicial.Value + i

            Else

                ' Manter a mesma data para as demais células

                dataValues(j, 1) = celDataInicial.Value

            End If

        Next j

        

        ' Transferir os dados de volta para a planilha

        Dim outputRange As Range

        Set outputRange = rngData.Offset((i - 1) * rngDados.Rows.Count).Resize(UBound(dataValues, 1), UBound(dataValues, 2))

        outputRange.Value = dataValues

    Next i

    

    ' Atualizar a célula com a nova data inicial (avançar a quantidade de dias do mês)

    Set celDataInicial = celInicialOriginal.Offset(numRows)

    

    ' Reativar atualização de tela e cálculo automático

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    

    ' Mensagem de sucesso

    MsgBox "Dados atualizados."

    

    Exit Sub

    

ErrorHandler:

    ' Reativar atualização de tela e cálculo automático em caso de erro

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    

    If Err.Number = 424 Then

        MsgBox "Operação cancelada pelo usuário."

    ElseIf Err.Number = 13 Then

        MsgBox "A célula selecionada como a data inicial não contém uma data válida. Operação cancelada."

    ElseIf Err.Number <> 0 Then

        MsgBox "Erro " & Err.Number & ": " & Err.Description, vbCritical

    Else

        MsgBox "Erro desconhecido."

    End If

End Sub

Link to comment
Share on other sites

1 answer to this question

Recommended Posts

  • 0

Pelo que entendi, você deseja replicar os dados do primeiro dia para os outros 30 dias do mês, alterando apenas a data. Seu código atual já parece fazer isso. No entanto, notei que você está incrementando a data apenas na primeira linha de cada conjunto de dados copiado. Se você deseja que a data seja incrementada para todas as linhas copiadas, você deve remover a condição If j = 1 Then e sempre incrementar a data, como mostrado abaixo:

For j = LBound(dataValues, 1) To UBound(dataValues, 1)
    ' Incrementar a data inicial
    dataValues(j, 1) = celDataInicial.Value + i
Next j

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      651.9k
×
×
  • Create New...