有没有办法转置某些列，同时保留其他列并在 Excel 中复制它们？

Question

我只需要将几列（例如：C:G）转置为一列，同时保留 A 列和 B 列中的信息。 因此，如果乔在星期一进行了销售，那么“星期一”将出现在新的“日”列中。然后下一行将再次出现 Joe，但这次是 Day 列中的“Wednesday”。然后，如果没有更多的值，那么转向史蒂夫并做同样的事情。我已经坚持了很长时间，所以任何建议或新方法将不胜感激。我不在乎它是使用公式还是 VBA 代码。

|   |   A   |   B   |   C    |    D    |     E     |    F     |   G    |
+---+-------+-------+--------+---------+-----------+----------+--------+
| 1 | Names | Sales | Monday | Tuesday | Wednesday | Thurday  | Friday |
| 2 | Joe   | 24500 | Monday |         | Wednesday |          |        |
| 3 | Steve | 15454 |        | Tuesday |           |          |        |
| 4 | Emily | 58421 |        | Tuesday | Wednesday | Thursday |        |
| 5 | Marie | 24582 | Monday |         |           |          | Friday |
+---+-------+-------+--------+---------+-----------+----------+--------+


+---+-------+-------+-----------+
|   |   A   |   B   |     C     |
+---+-------+-------+-----------+
| 1 | Names | Sales | Day       |
| 2 | Joe   | 24500 | Monday    |
| 3 | Joe   | 24500 | Wednesday |
| 4 | Steve | 15454 | Tuesday   |
| 5 | Emily | 58421 | Tuesday   |
| 6 | Emily | 58421 | Wednesday |
| 7 | Emily | 58421 | Thursday  |
| 8 | Marie | 24582 | Monday    |
| 9 | Marie | 24582 | Friday    |
+---+-------+-------+-----------+

Answer 1

想测试新的LET() 功能。

如果一个人在 Office 365 中有LET()（在撰写本文时仅对某些内部人员可用）

把它放在输出的第一个单元格中，Excel 会溢出结果：

=LET(RNG_1,A2:INDEX(A:A,MATCH("zzz",A:A)),RNG_2,B2:INDEX(B:B,MATCH("zzz",A:A)),RNG_3,C2:INDEX(G:G,MATCH("zzz",A:A)),RW,ROWS(RNG_3),CLM,COLUMNS(RNG_3),SEQ,SEQUENCE(RW*CLM,,0),TOT,CHOOSE({1,2,3},INDEX(RNG_1,INT(SEQ/CLM)+1),INDEX(RNG_2,INT(SEQ/CLM)+1),INDEX(RNG_3,INT(SEQ/CLM)+1,MOD(SEQ,CLM)+1)&""),FILTER(TOT,INDEX(TOT,0,3)<>""))

Answer 2

'VBA宏解决方案

子传输（）

Range("l2:n100").ClearContents
LstRw = Application.WorksheetFunction.CountA(Range("a:a"))

writeRw = 2
For rw = 2 To LstRw
    For col = 3 To 7
        If Not IsEmpty(Cells(rw, col)) Then
            Cells(writeRw, 12) = Cells(rw, 1)
            Cells(writeRw, 13) = Cells(rw, 2)
            Cells(writeRw, 14) = Cells(rw, col)
            writeRw = writeRw + 1
        End If
    
    Next col
Next rw

结束子

Answer 3

只是为了提供基于 Office 365 的进一步解决方案，我演示了一种使用 ►Worksheetfunction.Filter() 将转置的块工作日数据写回任何目标的 VBA 方法：

Sub UnpivotWeekdays()
Dim DataRange As Range
Set DataRange = Sheet1.Range("A2:G6")   ' << change to your needs referring to a sheet's Code(Name)

With Sheet2.Range("A2")                 ' << change to any wanted target cell
    Dim i As Long, ii As Long
    For i = 1 To DataRange.Rows.Count
        'get data blocks resized to 1..5 rows (here: Monday..Friday)
        Dim commoninfo:  commoninfo = getCommonInfo(DataRange, i)
        Dim weekdays:    weekdays = getWeekdays(DataRange, i)
        Dim cnt As Long: cnt = UBound(weekdays)
        
        'write identical common data to first two columns
        .Offset(ii).Resize(cnt, 2).Value = commoninfo
        'write weekdays to single column
        .Offset(ii, 2).Resize(cnt, 1) = Application.Transpose(weekdays)
        'increment current target offsets
        ii = ii + cnt
    Next
End With
End Sub

帮助功能

帮助函数getWeekdays() 使用Worksheetfunction.Filter() 并返回一个非空结果的“平面”数组，该数组将被转换为调用过程中的垂直条目：

Function getWeekdays(rng As Range, ByVal myRow As Long, Optional startColumn As Long = 3) As Variant()
'Purpose: filter valid weekdays (i.e. return only cells <> "")
'Note   : assuming day data in 3rd range column (defaulting startColumn = 3)
    Const DaysOfWeek = 5            ' here: Monday .. Friday
    Dim ad As String: ad = rng.Offset(0, startColumn).Resize(1, DaysOfWeek).Rows(myRow).Address
    On Error Resume Next
    getWeekdays = Evaluate("Filter(" & ad & ", " & ad & "<>"""")")
    If Err.Number <> 0 Then GoTo NOENTRIES
Exit Function
NOENTRIES:
    Dim tmp: ReDim tmp(1 To 1)
    getWeekdays = tmp
End Function

函数getCommonInfo()返回一个包含前两列的识别数据的数组，只要存在工作日条目就可以重复：

Function getCommonInfo(rng As Range, ByVal myRow As Long) As Variant()
'Purpose: get common info from first two range columns
    getCommonInfo = rng.Offset(myRow - 1).Resize(1, 2).Value
End Function