Transpor tabela para uma lista de coluna única

Question

Então eu tenho uma tabela cheia de dados que se parece com isso:

          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

E para cada pessoa, eu preciso imprimir uma nota para eles, que é algo como isto.

Person A
Subject A
Subject B
Subject D

Person B
Subject A
Subject B
Subject C

Person C
Subject C
Subject D

Portanto, deve ser vertical em vez de horizontal. Existem cerca de 930 alunos e 17 disciplinas. Além disso, existem 4 colunas para a classe, id, nome e número de cada aluno.

É possível fazê-lo apenas com funções do Excel ou o VBA deve ser implementado?

Eu também posso escrever para o aplicativo Visual Basic, é possível usar o Visual Basic para ler os dados e gerar um arquivo do Excel como resultado?

Se excelmfunction for usado, por favor me diga qual função usar. Se o VBA for usado, por favor me diga o guia ou função a seguir. Se o VB é para ser usado, por favor me diga as APIs usadas.

EDIT: Desde que eu preciso de um monte de pequenas notas, como sobre mala direta com o Word? É factível?

    

Answer 1

Eu estava entediado, então eu fiz um exemplo rápido para mostrar como começar.

• Fazer o download & abra o exemplo
• pressione Alt + F8 & inicie a macro
• veja a planilha 2

Eu não usei métodos avançados intencionais.
Cada linha de código é comentada para que outros possam adaptar o código.

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   

^{Clique para ver uma imagem maior}