将表格转置为单列表

Question

所以我有一张充满数据的表格，如下所示：

          Subject A   Subject B   Subject C   Subject D   Count
Person A     F           F                       F          3
Person B     F           F           F                      3
Person C                             F           F          2
Count        2           2           2           2

对于每个人，我都需要为他们打印一张便条，看起来像这样。

Person A
Subject A
Subject B
Subject D

Person B
Subject A
Subject B
Subject C

Person C
Subject C
Subject D

因此，它应该是垂直的而不是水平的。大约有 930 名学生和 17 个科目。此外，每个学生的班级、ID、姓名和编号有 4 列。

是否可以仅使用 Excel 函数来完成此操作，还是必须实现 VBA？

我也可以编写 Visual Basic 应用程序，是否可以使用 Visual Basic 读取数据并生成 Excel 文件作为结果？

如果要使用 excelmfunction，请告诉我使用什么函数。如果要使用 VBA，请告诉我要遵循的指南或函数。如果要使用 VB，请告诉我使用的 API。

编辑：因为我需要一堆小笔记，那么使用 Word 进行邮件合并怎么样？可行吗？

Answer 1

我很无聊，所以我举一个简单的例子向您展示如何开始。

• 下载并打开示例
• 按Alt+F8并启动宏
• 参见第二页

我并没有刻意使用高级方法。
每行代码都进行了注释，以便其他人可以调整代码。

Sub makenotes()
Sheets(2).ResetAllPageBreaks    'if there are some old page breaks, we delete them first

Dim subjects()  'create an empty array
subjects() = Array(5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19)   'which columns are subjects?

For irow = 2 To 34      'how many students (rows) should I loop through?
For icolumn = 1 To 19       'and per line: how many subjects & personal (columns) should I loop through?

ivalue = Sheets(1).Cells(irow, icolumn)     'save our cell value. we need it multiple times
if Not ivalue = vbNullString Then       'first we look if the cell has a value to print
    icount = icount + 1         'oh, we found something! lets increase our line counter (start is 0+1)

    On Error Resume Next    'the following match method will produce an error, if nothing will be found. We have to handle it.
    subjectcolumn = Application.Match(icolumn, subjects, 0)   'are we in a subject's column? not? ok give me the error
    On Error GoTo 0    'this turns off our error handle and everything is like before

    If IsError(subjectcolumn) Then       ' if we are not in a subject's column ...
        Sheets(2).Cells(icount, 1) = Sheets(1).Cells(irow, icolumn)  'then just write the normal cell value
    Else
        Sheets(2).Cells(icount, 1) = Sheets(1).Cells(1, icolumn)    'else write the header of that column
    End If
End If

Next icolumn      'we are finished with this column. Go back and start with the next column
Sheets(2).Rows(icount + 1).PageBreak = xlPageBreakManual     'ok, we are finished with that student. Lets insert a page break

Next irow  'and go back and start with the next student
Sheets(2).Columns(1).HorizontalAlignment = xlLeft   'add more formating commands. record them with the macro recorder
End Sub   

^{点击查看更大的屏幕截图}