0

Preciso organizar os dados que estão em ordem cronológica para um relatório que está em data. A Macro deve primeiro iterar pela coluna CRM, depois pela coluna DATA e organizar os registros de mesma data na mesma linha.

inserir a descrição da imagem aqui

Tentei a seguinte Macro, mas a condição If Str(Datarel.Value) = Str(Databd.Value) Then parece não funcionar. Obrigado!

     Sub macro()

    Dim i, j, k

    Set Id = Range("B1")
    Set Datarel = Range("B3")
    Set Idbd = Range("H2")
    Set Databd = Range("I2")
    Set Horabd = Range("J2")


    For i = 1 To 1
        For j = 1 To 31        
            For k = 1 To 12

            Datarel.Select

            If Str(Id.Value) = Str(Idbd.Value) Then
                If Str(Datarel.Value) = Str(Databd.Value) Then
                    If Str(Datarel.Offset(0, 1).Value) = "" Then
                        Datarel.Offset(0, 1).Value = Horabd.Value
                    ElseIf Str(Datarel.Offset(0, 3).Value) = "" Then
                        Datarel.Offset(0, 3).Value = Horabd.Value
                    ElseIf Str(Datarel.Offset(0, 4).Value) = "" Then
                        Datarel.Offset(0, 4).Value = Horabd.Value
                    ElseIf Str(Datarel.Offset(0, 5).Value) = "" Then
                        Datarel.Offset(0, 5).Value = Horabd.Value
                    End If
                End If
            End If            

            Set Idbd = Idbd.Offset(1, 0)
            Set Databd = Databd.Offset(1, 0)
            Set Horabd = Horabd.Offset(1, 0)
            Range("G1") = Range("G1") + 1
            Next k
            Set Datarel = Datarel.Offset(1, 0)
            Set Idbd = Range("H2")
            Set Databd = Range("I2")
            Set Horabd = Range("J2")
        Next j        

        Set Id = Id.Offset(34, 0)
    Next i
End Sub
7
  • 1
    Os dados de entrada da tabela não condizem com os dados de saída, favor fazer um Exemplo Mínimo, Completo e Verificável Commented 13/08/2019 às 13:12
  • Editei e tentei deixar mais claro. Obrigado. Commented 13/08/2019 às 14:36
  • 1
    Aparentemente o código não tem erro nenhum. Em qual linha dá a mensagem de erro? Execute utilizando a tecla F8 para ver qual linha gera o erro. Commented 13/08/2019 às 20:17
  • Na verdade não está dando erro. Descobri que o "If Str(Datarel.Value) = Str(Databd.Value) Then" não está funcionando quando a condição é verdadeira. Sera que é algum problema com o Str que não funciona com o tipo Data? Não sei como isso funciona no VBA. Commented 13/08/2019 às 22:18
  • Em vez de Str, utilizei CDate e passou a dar certo. Porém o Else If é é executado mesmo se o If anterior é verdadeiro, como se fosse um If seguido. Commented 16/08/2019 às 10:35

1 Resposta 1

1

Solucionado! segue o resultado.

Sub macro()

    Dim i, j, k

    Set Id = Range("B1")
    Set Datarel = Range("B3")
    Set Idbd = Range("H2")
    Set Databd = Range("I2")
    Set Horabd = Range("J2")


    For i = 1 To 1
        For j = 1 To 31
            For k = 1 To 12

            Datarel.Select

            If Str(Id.Value) = Str(Idbd.Value) Then
                If CDate(Datarel.Value) = CDate(Databd.Value) Then
                    If Datarel.Offset(0, 1).Value = "" Then
                        Datarel.Offset(0, 1).Value = Horabd.Value
                    ElseIf Datarel.Offset(0, 2).Value = "" Then
                        Datarel.Offset(0, 2).Value = Horabd.Value
                    ElseIf Datarel.Offset(0, 3).Value = "" Then
                        Datarel.Offset(0, 3).Value = Horabd.Value
                    ElseIf Datarel.Offset(0, 4).Value = "" Then
                        Datarel.Offset(0, 4).Value = Horabd.Value
                    End If
                End If
            End If

            Set Idbd = Idbd.Offset(1, 0)
            Set Databd = Databd.Offset(1, 0)
            Set Horabd = Horabd.Offset(1, 0)             
            Next k
            Set Datarel = Datarel.Offset(1, 0)
            Set Idbd = Range("H2")
            Set Databd = Range("I2")
            Set Horabd = Range("J2")
        Next j

        Set Id = Id.Offset(34, 0)
        Set Datarel = Id.Offset(2,0)

    Next i
End Sub

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .