A macro do Excel gera um relatório com base em dados brutos

Question

Atualmente, estou trabalhando em uma macro para criar um relatório de pontuação dos alunos e mostrar uma porcentagem no final de cada aluno.

Euachoqueaimageméauto-explicativa.Eutenhodadosdealunoscomomostradonoladoesquerdoequeroumrelatóriocomoesseàdireita.Euconseguicriarmacropara1alunoereexecutarcadavezparacadaaluno,masnãoseicomofazerrelatóriosparatodososalunosaomesmotempoepararquandotodososalunosterminarem.

Ocódigoaseguiréparacriarumanovalinhatodavezqueumnovonomedealunoocorrer:

DimiRowAsInteger,iColAsIntegerDimoRngAsRangeSetoRng=Range("A4")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
    iRow = iRow + 2


Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""

Mas não sei onde inserir o código para cálculo de porcentagem.

ActiveCell.FormulaR1C1 = "=(R[-3]C+R[-2]C+R[-1]C)/COUNT(R[-3]C:R[-1]C)"

Eu sei que é bem simples de calcular, mas eu não sei como fazer o loop. Eu posso mesclar as células e criar uma caixa para células. Não sei se estou fazendo corretamente. Mas se há uma maneira simples de fazer isso acontecer, por favor me avise. Acho que estou tomando um longo caminho, mas sou um iniciante nisso. E onde devo inserir o código de mesclagem para que o nome da pessoa seja mesclado.

Por favor, deixe-me saber se algo não está claro.

Obrigado antecipadamente.

P.S. Eu não sou um professor. Eu só quero criar um relatório como este

    

Answer 1

Você deseja:

1. Insira uma linha abaixo do nome de cada aluno
2. Mesclar as células do nome do aluno (suponho que seja o que as letras representam)
3. Adicione bordas, incluindo bordas mais grossas para o aluno
4. Calcule uma média para cada aluno

Aqui está uma solução:

Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Dim nRng As Range
Dim persRng As Range
Dim avgRng As Range

Set oRng = Range("A4")

iRow = oRng.Row
iCol = oRng.Column

Do

    If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
        ' Insert row below student name
        Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
        ' merge name cells
        Set nRng = Range(Cells(iRow + 1, iCol), Cells(iRow - 2, iCol))
        With nRng
            Application.DisplayAlerts = False
            .Merge
            Application.DisplayAlerts = True
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignCenter
            .Font.Bold = True
        End With
        ' Add borders
        Set persRng = Range(Cells(iRow + 1, iCol), Cells(iRow - 2, iCol + 2))
        With persRng.Borders
            .LineStyle = xlContinuous
            .Color = vbBlack
            .Weight = xlThin
        End With
        ' Thick border around average cells
        Set avgRng = Range(Cells(iRow + 1, iCol + 1), Cells(iRow + 1, iCol + 2))
        avgRng.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=vbBlack
        ' Add percent sign and calculate average
        Cells(iRow + 1, iCol + 1).Value = "%"
        Cells(iRow + 1, iCol + 2) _
            .FormulaR1C1 = "=(R[-3]C+R[-2]C+R[-1]C)/COUNT(R[-3]C:R[-1]C)"
        Cells(iRow + 1, iCol + 2).Font.Bold = True
        iRow = iRow + 2


    Else
        iRow = iRow + 1
    End If

Loop While Not Cells(iRow, iCol).Text = ""

    

Answer 2

Eu modifiquei um pouco o código acima para que agora eu possa ter vários assuntos, mas não sei como modificar a fórmula para fazer isso.

Dim iRow As Integer, iCol As Integer, nRow As Integer, mRow As Integer
Dim oRng As Range
Dim nRng As Range
Dim persRng As Range
Dim avgRng As Range

Set oRng = Range("A4")

iRow = oRng.Row
iCol = oRng.Column
nRow = Application.WorksheetFunction.CountIf(Range("A1:A12"), "a")
mRow = nRow - 1

Do

    If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
        ' Insert row below student name
        Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
        ' merge name cells
        Set nRng = Range(Cells(iRow + 1, iCol), Cells(iRow - mRow, iCol))
        With nRng
            Application.DisplayAlerts = False
            .Merge
            Application.DisplayAlerts = True
            .VerticalAlignment = xlVAlignCenter
            .HorizontalAlignment = xlHAlignCenter
            .Font.Bold = True
        End With
        ' Add borders
        Set persRng = Range(Cells(iRow + 1, iCol), Cells(iRow - mRow, iCol + 2))
        With persRng.Borders
            .LineStyle = xlContinuous
            .Color = vbBlack
            .Weight = xlThin

        End With
        ' Thick border around average cells
        Set avgRng = Range(Cells(iRow + 1, iCol + 1), Cells(iRow + 1, iCol + 2))
        avgRng.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=vbBlack
        ' Add percent sign and calculate average
        Cells(iRow + 1, iCol + 1).Value = "%"
        Cells(iRow + 1, iCol + 2) _
            .FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)/COUNT(R[-5]C:R[-1]C)"
        Cells(iRow + 1, iCol + 2).Font.Bold = True
        iRow = iRow + mRow


    Else
        iRow = iRow + 1
    End If

Loop While Not Cells(iRow, iCol).Text = ""

Até este, está tudo bem. Mas não consigo obter a média de assuntos se for algo diferente de 5. Eu tentei mudar o valor inteiro, mas parece que não funciona.

Cells(iRow + 1, iCol + 2) _
                .FormulaR1C1 = "=SUM(R[-nRow]C:R[-1]C)/COUNT(R[-nRow]C:R[-1]C)"

Como posso fazer isso? Preciso criar outro loop para isso?