Сложный Excel Транспонировать

Question

Мне нужно перенести некоторые данные в совершенно другой формат, и мне кажется, что ничего не работает.Я устал Pivot Table, SUMIF, VLOOKUP и Concatenate, но проблема не решается.

У меня есть данные в следующем формате:

CUSTOMER  Date         HOUR 1 HOUR 2 HOUR 3 HOUR 4.......HOUR 24
A         2019-02-20    1.5   1.7    1.9   1.10         1.78
A         2019-02-21    1.1   1.8    1.2   1.10         1.75
B         2019-02-20    1.0   1.2    1.4   1.29         1.73
B         2019-02-21    1.5   1.7    1.9   1.10         1.78

Я хочу, чтобы эти данные были перенесены в следующий формат:

DATE            CUSTOMER 

2019-02-20     A       B
HOUR 1        1.5      1.0 
HOUR 2        1.7      1.2
HOUR 3        1.9      1.4
HOUR 4        1.10     1.29
.
.
.
HOUR 24      1.78      1.73

2019-02-21   

HOUR 1       1.1       1.5  
HOUR 2       1.8       1.7
HOUR 3       1.2       1.9
HOUR 4       1.10      1.10
.
.
.
HOUR 24      1.75      1.78

Посоветуйте, пожалуйста, как мне этого добиться?

Answer 1

Я уверен, что есть более элегантное решение, чем это ... но, похоже, оно работает. Я не приложил много усилий для очистки кода - в нем все еще есть Остановки

Процесс таков;.. Сортировать данные по дате .. Считать их в массив .. переупорядочить по ходу работы .. Записать массив на другой лист

Sub ReArrangeMyData()
    ' First Sort the Raw Data by Date
      Application.Goto Reference:="rawdatarng"
      ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add2 Key:=Range("B11:B14"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A10:Z14")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
      End With
    ' Sorted

    Dim NewData(1 To 99, 1 To 26) As Variant

    ' Now parse each Row and Re-Arrange into new sheet ... via the NewData Array
      Dim SrcRng As Range, xRow As Range, tgtRow As Long, tgtCol As Long
      Dim FirstRow As String, dDate As String, dCust As String, i As Long, LastDate As String

      Set SrcRng = ActiveSheet.Range("RawDataRng")
      tgtRow = 0
      tgtCol = 0
      FirstRow = "Y"
      LastDate = "AnyInvlidRubbish"
      For Each xRow In SrcRng.Rows
         If FirstRow <> "Y" Then
            dDate = CStr(xRow.Cells(1, 2).Value)
            dCust = CStr(xRow.Cells(1, 1).Value)
            If dDate <> LastDate Then
               ' New Date = NewRow
               tgtRow = IIf(tgtRow = 0, 1, tgtRow + 26) ' Uses 1st Row on 1st Date then Jumps 26 Rows for other dates
               tgtCol = 0
               tgtCol = tgtCol + 1
               NewData(tgtRow, tgtCol) = dDate
               tgtCol = tgtCol + 1
               NewData(tgtRow, tgtCol) = dCust
               For i = 1 To 24
                  NewData(tgtRow + i, 1) = "Hour " & Right("00" & i, 2)
               Next i
            Else
               'tgtCol = tgtCol + 1
               'NewData(tgtRow, tgtCol) = dDate
               Stop
               tgtCol = tgtCol + 1
               NewData(tgtRow, tgtCol) = dCust
            End If

            For i = 1 To 24
               NewData(tgtRow + i, tgtCol) = CStr(xRow.Cells(1, 2 + i).Value)
            Next i
            LastDate = dDate
         End If
         FirstRow = "N"
      Next xRow
      Stop

      ' Finally Write the NewData Array into a different sheet
      For i = 1 To 99
         For J = 1 To 26
            ThisWorkbook.Sheets("Sheet3").Cells(5 + i, J).Value = NewData(i, J)
         Next J
      Next i
      Stop
    ' Done
End Sub