Question

我必须将一些数据转换为完全不同的格式，并且似乎没有任何工作对我有用。我已经厌倦了数据透视表，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

我敢肯定，有比这更优雅的解决方案了……但它似乎可行我没有花太多精力清理代码-仍然有Stops

过程是； ..按日期对数据进行排序 ..将其读入数组..随着我们的进行重新排列 ..将数组写入另一张纸

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

复杂的Excel转置

1 个答案: