使用数组求助表

时间:2019-02-03 14:54:56

标签: excel vba excel-formula phpexcel

我试图使用Code重新整理数据,请考虑如下数据形状:

Empid| 1/01/2019|2/01/2019 | 3/01/2019
-------------------------------------------
1    |    A     |    B     |    A
2    |    B     |    A     |    B
3    |    B     |    C     |    C
4    |    A     |    A     |    A

和这样的目标形状:

Empid | Date     | Shift
---------------------
 1    |1/01/2019 | A
 1    |2/01/2019 | B
 1    |3/01/2019 | A
 2    |1/01/2019 | B
 2    |2/01/2019 | A
 2    |3/01/2019 | B
 3    |1/01/2019 | B
 3    |2/01/2019 | C
 3    |3/01/2019 | C
 4    |1/01/2019 | A
 4    |2/01/2019 | A
 4    |3/01/2019 | A

我使用了此代码,并使用以下代码达到了这种形状:

Empid | Shift
---------------------
 1    |A
 1    |B
 1    |A
 2    |B
 2    |A
 2    |B
 3    |B
 3    |C
 3    |C
 4    |A
 4    |A
 4    |A

这是vba代码:

Sub TransposeData()
    Const FirstDataRow As Long = 2               ' presuming row 1 has headers
    Const YearColumn As String = "A"             ' change as applicable

    Dim Rng As Range
    Dim Arr As Variant, Pos As Variant
    Dim Rl As Long, Cl As Long
    Dim R As Long, C As Long
    Dim i As Long

    With ActiveSheet
        Cl = .UsedRange.Columns.Count - .UsedRange.Column + 1
        Rl = .Cells(.Rows.Count, Columns(YearColumn).Column).End(xlUp).Row
        Set Rng = Range(.Cells(FirstDataRow, YearColumn), .Cells(Rl, Cl))
    End With
    Arr = Rng.Value
    ReDim Pos(1 To (UBound(Arr) * UBound(Arr, 2)), 1 To 2)

    For R = 1 To UBound(Arr)
        For C = 2 To UBound(Arr, 2)
            i = i + 1
            Pos(i, 1) = Arr(R, 1)
            Pos(i, 2) = Arr(R, C)
        Next C
    Next R

    R = Rl + 5                                   ' write 5 rows below existing data
    Set Rng = ActiveSheet.Cells(R, YearColumn).Resize(i, 2)
    Rng.Value = Pos
End Sub

2 个答案:

答案 0 :(得分:1)

使用Power Query(在Excel 2016+中也称为Get & Transform)。

  • 选择第一列,然后 UN 透视其他列。
  • 重命名结果“日期”列(由GUI命名为Attributes)和Shift列(由GUI命名为Value)。

    < / li>
  • 如果要在VBA中执行此操作,请在运行PQ时记录一个宏


  1. 在表格中选择一个单元格后,从Get & Transform中选择Table/Range

enter image description here

  1. 电源查询将打开。确保已选择第一列。然后,从“转换”中,选择Unpivot按钮旁边的下拉菜单。从该下拉列表中,选择unpivot other columns

enter image description here

  1. 选择后,您将看到需要重命名第2列和第3列

enter image description here

  1. 然后,从“文件”菜单中选择“关闭”选项之一,然后将结果加载到同一张纸或另一张纸上。

现在,如果您的数据发生更改,您可以重新运行查询。

而且,正如我在上文所述,如果您需要使用VBA进行此操作,则只需在执行步骤的同时记录一个宏即可。

我还建议您在SO中搜索取消枢纽,这样您会获得很多信息。

答案 1 :(得分:0)

数组方法

Option Explicit

Public Sub Rearrange()
  Dim t#: t = timer                                                 ' stop watch
  Dim ws As Worksheet                                               ' worksheet object
  Set ws = ThisWorkbook.Worksheets("Sheet3")                        ' << change to sheet name
  Const STARTCOL = "A"                                              ' << change to your needs
' [1] get last row in column A
  Dim r&, c&                                                        ' used rows/cols (assuming no blanks)
  r = ws.Range(STARTCOL & ws.Rows.count).End(xlUp).Row
  c = ws.Columns(STARTCOL).End(xlToRight).Column - ws.Columns(STARTCOL).Column
' [2] get values to 1-based 2-dim variant arrays
  Dim tmp, tgt
  tmp = ws.Range(ws.Cells(1, STARTCOL), ws.Cells(r, c + 1)).Value2
  ReDim tgt(1 To c * (UBound(tmp) - 1) + 1, 1 To c)                 ' resize target array
' [3] rearrange data in target array
  Dim i&, ii&, j&
  For i = 2 To UBound(tmp)
      For j = 2 To UBound(tmp, 2)                                   ' get row data
          ii = (i - 1) * c + j - c                                  ' calculate new row index
          tgt(ii, 1) = tmp(i, 1)                                    ' get ID
          tgt(ii, 2) = tmp(1, j)                                    ' get date
          tgt(ii, 3) = tmp(i, j)                                    ' get inditgtidual column data
      Next j
  Next i
  tgt(1, 1) = "EmpId": tgt(1, 2) = "Date": tgt(1, 3) = "Shift"      ' get captions

' [4] write target array back wherever you want it to               ' << redefine OFFSET
  ws.Range("A1").Offset(0, c + 2).Resize(UBound(tgt, 1), UBound(tgt, 2)) = tgt

  MsgBox "Time needed: " & Format(timer - t, "0.00") & " seconds."

End Sub

注意

您应该使用首选的日期格式来格式化目标范围,例如"dd/mm/yyyy;@"