Início / computer / Perguntas / 1743895
Accepted
BmyGuest
Asked: 2022-09-24 00:16:49 +0800 CST

Como posso reordenar melhor os dados no formato misto de linha/coluna em uma tabela simples?

  • 772

Eu tenho (de um arquivo CVS) dados no seguinte formato:

Os dados são uma lista contínua (linha por linha de valores separados por vírgulas) onde em locais arbitrários as colunas são inseridas ou removidas. Nessas ocasiões, uma nova linha de 'cabeçalho' é adicionada. A primeira coluna é sempre a data. Uma importação direta ficaria assim:

Formato da tabela de fonte de dados

Agora, o que eu precisaria para uma avaliação de dados adicional é uma tabela como a seguinte: Formato de tabela de dados desejado

Como tenho muitos dados nesse formato, o rearranjo manual não é uma opção.

Como posso conseguir este recurso automaticamente?

Ou por importação de consulta do arquivo CVS para o Excel ou por manipulação subsequente do Excel?

microsoft-excel worksheet-function

1 respostas

  1. Best Answer

    Do ponto de vista dos computadores e da teoria de banco de dados relacional, é muito melhor transformar seus dados mistos desta forma:

    Formulário de nova tabela

    Este trabalho pode ser feito rapidamente pelo seguinte script:

    Option Explicit

Sub repackMixedData()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim oTargetCell As Range
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    Set sheet = ThisWorkbook.Worksheets.Add()
    Set oTargetCell = sheet.Range("A1")
    With oTargetCell.Resize(1, 3)
        .Value = Array("Date", "Item", "Value")
        .Font.Bold = True
    End With
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If Not IsEmpty(oCell) Then
                    Set oTargetCell = oTargetCell.Offset(1, 0)
                    oTargetCell.Value2 = oCellDate.Value2
                    oTargetCell.NumberFormat = oCellDate.NumberFormat
                    oTargetCell.Offset(0, 1) = rHeader.Cells(1, oCell.Column).Text
                    oTargetCell.Offset(0, 2) = oCell.Value
                End If
            Next oCell
        End If
    Next rRow
End Sub

    E com a tabela "plana" resultante, você pode fazer qualquer coisa, por exemplo, criar uma tabela dinâmica e obter um resultado semelhante à sua segunda captura de tela.

    Atualização Desde que se descobriu que há muito mais dados reais do que o esperado, a macro foi ligeiramente melhorada. Por favor, tente esta opção - deve ser um pouco mais rápido.

    Sub repackMixedData2()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim countOfValues As Long
Dim arrResult As Variant
Dim index As Long
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    countOfValues = Application.WorksheetFunction.CountA(rSource.Offset(0, 1))
ReDim arrResult(1 To countOfValues, 1 To 3) As Variant
    index = 1
    arrResult(index, 1) = "Date"
    arrResult(index, 2) = "Item"
    arrResult(index, 3) = "Value"
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If IsEmpty(oCell) Then Exit For
                index = index + 1
                arrResult(index, 1) = oCellDate.Value2
                arrResult(index, 2) = rHeader.Cells(1, oCell.Column).Text
                arrResult(index, 3) = oCell.Value
            Next oCell
        End If
    Next rRow
    
    Set sheet = ThisWorkbook.Worksheets.Add()
    sheet.Range("A1:C" & index).Value2 = arrResult
    sheet.Range("A1:C1").Font.Bold = True
    sheet.Range("A:A").NumberFormat = oCellDate.NumberFormat
End Sub
    • 1

relate perguntas