таблица с использованием массива

Question

пытаюсь обработать данные, используя код, рассмотрим форму данных следующим образом:

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

Answer 1

Подход к массиву

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;@".

Answer 2

Используйте Power Query (он же Get & Transform в Excel 2016 +).

• Выберите первый столбец и UN поверните другие столбцы.

• Переименуйте результирующий столбец Дата (который будет именоваться Attributes в графическом интерфейсе) и столбец Shift (который будет именоваться Value в графическом интерфейсе).

• Если вы хотите сделать это в VBA, запишите макрос во время выполнения PQ

---

1. Выбрав в таблице одну ячейку, выберите Get & Transform из Table/Range

Откроется Power Query.Убедитесь, что вы выбрали первый столбец.Затем в Transform выберите раскрывающийся список рядом с кнопкой Unpivot.Из этого выпадающего списка выберите unpivot other columns.

После выбора этого вы увидите, что вам нужно переименовать столбцы 2 и 3

После этого выберите один из параметров «Закрыть» в меню «Файл» и загрузите результаты либо на тот же, либо на другой лист.

Теперь вы можете перезапустить запрос, если ваши данные изменятся.

И, как я уже писал выше, если вам нужно сделать это с помощью VBA, просто запишите макрос во время выполнения шагов.

Я также предлагаю вам поискать SO для unpivot и вы получите много информации.