Excel análise de dados no excel

[Jeff_Sandes]

Tenho uma tabela com a combinação de produtos A,B,C,D e E, o momento em que os produtos foram adicionados estão organizadas em ordem vertical, porém não há a organização horizontal, estou tentando desenvolver uma macro VBA para organizar horizontalmente os dados dispostos nas células. Abaixo segue a imagem de como vem e como gostaria de desenvolver, à esquerda é como os dados vem e à direita é como deveriam estar, além de mostrar as combinações dos produtos em células separadas. Seria possível fazer essa análise célula a células deslocando que para baixo os valores que não correspondem a ordem horizontal?

[Midori]

@Jeff_Sandes Para copiar os dados para a outra configuração, a macro vai apagar os originais.

 

Sub OrganizaHorario()
    Dim Area    As Range
    Dim Procura As Range
    Dim Menor   As String
    Dim Linha   As Long
    
    Set Area = [A2:E18]
    Area.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Linha = 2
    
    While WorksheetFunction.CountA(Area) <> 0
        Menor = Format(WorksheetFunction.Min(Area), "HH:MM:SS")
        
        Set Procura = Area.Find( _
            What:=Menor, LookIn:=xlValues, LookAt:=xlWhole)
                        
            If Not Procura Is Nothing Then
                Do
                    ThisWorkbook.ActiveSheet.Cells( _
                        Linha, Procura.Column + [G:G].Column - 1).Value = Menor
                    
                    Procura.Value = ""
                    Set Procura = Area.FindNext(Procura)
                Loop Until Procura Is Nothing
            Else
                MsgBox "Erro"
                Exit Sub
            End If
        Linha = Linha + 1
    Wend
End Sub

 

[Jeff_Sandes]

39 minutos atrás, Midori disse:

@Jeff_Sandes Para copiar os dados para a outra configuração, a macro vai apagar os originais.

 

Sub OrganizaHorario()
    Const FORMATO   As String = "[$-x-systime]h:mm:ss AM/PM"
    Dim Area        As Range
    Dim Procura     As Range
    Dim Menor       As Variant
    Dim Linha       As Long
    
    Set Area = [A2:E18]
    Area.NumberFormat = FORMATO
    Linha = 2
    
    While WorksheetFunction.CountA(Area) <> 0
        Dim CelulaHora As Range
        Menor = Format(WorksheetFunction.Min(Area), "HH:MM:SS")
        
        Set Procura = Area.Find( _
            What:=Menor, LookIn:=xlValues, LookAt:=xlWhole)
                        
            If Not Procura Is Nothing Then
                Do
                    Set CelulaHora = _
                        ThisWorkbook.ActiveSheet.Cells( _
                        Linha, Procura.Column + [G:G].Column - 1)
                    
                    CelulaHora.Value = Procura.Value
                    CelulaHora.NumberFormat = FORMATO
                    Procura.Value = ""
                    
                    Set Procura = Area.FindNext(Procura)
                Loop Until Procura Is Nothing
            Else
                MsgBox "Erro"
                Exit Sub
            End If
        Linha = Linha + 1
    Wend
End Sub

 

caso eu precise mudar o formato das horas para 'HH:MM' e mudar a área onde o resultado seja deslocado, como faço? Tentei mudar os formatos e mover para a coluna AZ, mas não deu

[Midori]

@Jeff_Sandes Para mudar o formato você pode atribuir os 5 primeiros caracteres da string menor: Left(Menor, 5). O código coloca os dados a partir da coluna G, se quiser outra é só editar esta parte: [G:G].Column