Continuando com a resolução dos meus primeiros exercícios em Vba aqui fica mais um:

Elabore um algoritmo que permita Somar  5 Células na Horizontal a Partir da Célula Seleccionada.

Aqui fica o código que resolve o exercício:

Sub MatrixMult()
    Dim a(1 To 3, 1 To 3) As Double, b(1 To 3, 1 To 3) As Double
    Dim m(1 To 3, 1 To 3) As Double

    Dim i As Integer, j As Integer, k As Integer

    Dim s As Double

    Dim aCell As Range, bCell As Range, mCell As Range

    ' guardar valores das células A1:C3 na matriz a()
    Set aCell = Range("A1")
    For i = 1 To 3 ' linha
        For j = 1 To 3 ' coluna
            a(i, j) = aCell.Offset(i - 1, j - 1).Value
        Next j
    Next i

    ' guardar valores das células E1:G3 na matriz b()
    Set bCell = Range("E1")
    For i = 1 To 3 ' linha
        For j = 1 To 3 ' coluna
            b(i, j) = bCell.Offset(i - 1, j - 1).Value
        Next j
    Next i

    ' calcula o produto
    For i = 1 To 3 ' linha
        For j = 1 To 3 ' coluna
            s = 0
            For k = 1 To 3
                s = s + a(i, k) * b(k, j)
            Next k
            m(i, j) = s
        Next j
    Next i

    ' apresentar os valores de m(i,j) nas células I1:K3
    Set mCell = Range("I1")
    For i = 1 To 3 ' linha
        For j = 1 To 3 ' coluna
            mCell.Offset(i - 1, j - 1).Value = m(i, j)
        Next j
    Next i
End Sub

Não sei se a forma como implementei a resolução do exercício é a mais correcta, e por isso fico à espera de comentários, ou mesmo de correcções e dicas de melhoramento do código que apresento.

Share

Continuando com a resolução dos meus primeiros exercícios em Vba aqui fica mais um:

Elabore um algoritmo que permita Construir uma Matriz Quadrada Cujos os Elementos Sejam a Soma dos Seus Índices.

Aqui fica o código que resolve o exercício:

Sub BuildMatrixij()
    Dim InitialCell As Range
    Dim n As Integer
    Dim mat() As Integer
    Dim i As Integer, j As Integer

    ' Tamanho da matriz
    Do
        n = InputBox("Tamanho da matriz?")
    Loop Until n < 1001

    ' Dimensionar a matriz
    ReDim mat(1 To n, 1 To n)

    ' calcular a matriz
    For i = 1 To n ' linhas
        For j = 1 To n ' colunas
            mat(i, j) = i + j
        Next j
    Next i

    ' Imprimir na folha a matriz
    Set InitialCell = Range("A1") '  Primeira célula

    For i = 1 To n ' linhas
        For j = 1 To n ' colunas
            InitialCell.Offset(i - 1, j - 1).Value = mat(i, j)
        Next j
    Next i
End Sub

Não sei se a forma como implementei a resolução do exercício é a mais correcta, e por isso fico à espera de comentários, ou mesmo de correcções e dicas de melhoramento do código que apresento.

Share

Continuando com a resolução dos meus primeiros exercícios em Vba aqui fica mais um:

Elabore um algoritmo que permita Calcular a Média das Linhas e das Colunas a Partir  da Célula Activa.

Aqui fica o código que resolve o exercício:

Sub MatrixAverageRC()

    Dim InitialCell As Range

    Dim c() As Double
    Dim AverageColumn() As Double, AverageRow() As Double

    Dim s As Double
    Dim nColumns As Integer, nRows As Integer
    Dim i As Integer, j As Integer

    Set InitialCell = ActiveCell

    ' Calcular o número de linhas
    nRows = 0
    Do
        nRows = nRows + 1
    Loop Until IsEmpty(InitialCell.Offset(nRows, 0))

    ' Calcular o número de colunas
    nColumns = 0
    Do
        nColumns = nColumns + 1
    Loop Until IsEmpty(InitialCell.Offset(0, nColumns))

    ' redimensionar os vectores e as matrizes
    ReDim c(1 To nRows, 1 To nColumns)
    ReDim AverageColumn(1 To nColumns)
    ReDim AverageRow(1 To nRows)

    ' guardar valores das células na matriz c()
    For j = 1 To nRows ' linha
        For i = 1 To nColumns ' coluna
            c(j, i) = InitialCell.Offset(j - 1, i - 1).Value
        Next i
    Next j

    ' calcula a média das linhas
    For j = 1 To nRows ' linhas
        s = 0
        For i = 1 To nColumns ' colunas
           s = s + c(j, i)
        Next i
        AverageRow(j) = s / nColumns ' calcula a média e guarda

        ' Apresenta a média numa célula
        ActiveCell.Offset(j - 1, nColumns).Value = AverageRow(j)
        ActiveCell.Offset(j - 1, nColumns).Font.Bold = True
    Next j

    ' calcula a média das colunas
    For i = 1 To nColumns ' colunas
        s = 0
        For j = 1 To nRows ' linhas
           s = s + c(j, i)
        Next j
        AverageColumn(i) = s / nRows ' calcula a média e guarda

        ' Apresenta a média numa célula abaixo
        ActiveCell.Offset(nRows, i - 1).Value = AverageColumn(i)
        ActiveCell.Offset(nRows, i - 1).Font.Bold = True
    Next i
End Sub

Não sei se a forma como implementei a resolução do exercício é a mais correcta, e por isso fico à espera de comentários, ou mesmo de correcções e dicas de melhoramento do código que apresento.

Share

Continuando com a resolução dos meus primeiros exercícios em Vba aqui fica mais um:

Elabore um algoritmo que permita Sinalizar as 25 Células que Estão à Direita e Abaixo da Célula Activa que Contenham Números Pares.

Aqui fica o código que resolve o exercício:

Sub MatrixEvenCells()
    Dim c(1 To 5, 1 To 5) As Double
    Dim i As Integer, j As Integer

    ' guardar valores das células na matriz c()
    For j = 1 To 5 ' linha
        For i = 1 To 5 ' coluna
            c(j, i) = ActiveCell.Offset(j - 1, i - 1).Value

          If c(j, i) Mod 2 = 0 Then

            ' fundo vermelho
             ActiveCell.Offset(j - 1, i - 1).Interior.ColorIndex = 3 
            ' Texto branco
            ActiveCell.Offset(j - 1, i - 1).Font.ColorIndex = 2 
          End If
        Next i
    Next j

End Sub

Não sei se a forma como implementei a resolução do exercício é a mais correcta, e por isso fico à espera de comentários, ou mesmo de correcções e dicas de melhoramento do código que apresento.

Share

Continuando com a resolução dos meus primeiros exercícios em Vba aqui fica mais um:

Elabore um algoritmo que permita Somar  5 Células na Horizontal e na Vertical a Partir da Célula Seleccionada.

Aqui fica o código que resolve o exercício:

Sub MatrixSum()
    Dim s As Double
    Dim c(1 To 5, 1 To 5) As Double
    Dim i As Integer, j As Integer

    ' guardar valores das células na matriz c()
    For j = 1 To 5 ' linha
        For i = 1 To 5 ' coluna
            c(j, i) = ActiveCell.Offset(j - 1, i - 1).Value
        Next i
    Next j

    ' somar valores
    s = 0
    For j = 1 To 5 ' linha
        For i = 1 To 5 ' coluna
            s = s + c(j, i)
        Next i
    Next j

    ' Apresentar resultado
    MsgBox s
End Sub

Não sei se a forma como implementei a resolução do exercício é a mais correcta, e por isso fico à espera de comentários, ou mesmo de correcções e dicas de melhoramento do código que apresento.

Share