Par e Impar

Exercício Intermediário

Enunciado

Crie um InputBox no qual os valores inseridos vão sendo adicionados na coluna "A". Crie outra Sub que transfira os valores pares acima de 42, em ordem crescente para a linha 1 da aba "SVBA_Exportar", e os valores impares elevados ao quadrado, em ordem decrescente para a linha 3 da "SVBA_Exportar". Faça com que o InputBox não aceite caracteres não numéricos e números não inteiros. Além disso, o algoritmo deve parar quando o usuário der "OK" com o input vazio.

Conceitos Sugeridos:

Dim
End com .Row
If Then Else
Msgbox
Do Loop
For Next
Set
Offset
CurrentRegion
InputBox
IsNumeric - Função que retorna True se o valor for numérico
CInt
CDbl
With

Lembre-se que na maioria dos casos há mais de uma forma de resolver o problema.

Dica: Para ordenação, crie um loop dentro do outro. Caso a variável do segundo loop tenha valor maior do que a do primeiro, substitua a variável.

Exercício Resolvido

Resolvendo o Problema

Passo 1 - Começamos pela subrotina que irá plotar os dados na tabela

Declaramos as variáveis
```
Dim ValC As Variant
Dim i As Integer
```
Atribuímos a variável i o valor 2 e criamos um Do...Loop Until
```
i = 2
Do
```

Dentro do Do Loop criamos um InputBox, e atribuímos ao valor da variável ValC este input do usuário

ValC = InputBox("Insira um número" & vbCrLf & vbCrLf & "Clique em Ok ou Cancel com a entrada vazia quando tiver terminado.", "SuperExcelVBA")

Inserimos duas condicionais If Then. A primeira, caso o usuário insira um conteúdo não numérico, fará com que ele receba um aviso via MsgBox. A segunda, caso o conteúdo seja não numérico e vazio sairá do Do Loop.
```
If Not IsNumeric(ValC) Then
    If ValC = vbNullString Then
        Exit Do
    End If
    MsgBox "Insira conteúdo numérico", vbCritical, "SuperExcelVBA"
```

Prosseguimos com as condicionais, agora caso o conteúdo seja numérico e não inteiro o usuário receberá um aviso.

Else
    If CInt(ValC) <> CDbl(ValC) Then
    MsgBox "Insira apenas números inteiros", vbCritical, "SuperExcelVBA"

Por fim, caso o usuário insira um valor numérico e inteiro, este valor será atribuído a ValC e será plotado na planilha
```
Else
i = i + 1
Cells(i, 1) = ValC
```

Para estética, configuramos o padrão da borda da célula plotada

        With Cells(i, 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).Weight = xlHairline
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeRight).Weight = xlHairline
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlHairline
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeTop).Weight = xlHairline
        End With
        End If
    End If
Loop Until ValC = vbNullString

Passo 2 - Passamos agora para a subrotina que irá exportar os dados conforme os critérios do exercício

Declaramos as variáveis

Dim j As Integer
Dim UltLinha As Long
Dim ValC As Double
Dim temp As Long
Dim p As Integer
Dim i As Long
Dim Rng As Range

Atribuímos o último dado das linhas da planilha "SVBA_Gabarito" (ou "SVBA_Exercicio", caso esteja na planilha de exercício) a variável UltLinha.
```
UltLinha = Sheets("SVBA_Gabarito").Cells(Rows.Count, 1).End(xlUp).Row
```
Criamos um loop For Next da terceira linha até o último dado da planilha
```
For j = 3 To UltLinha
```
Atribuímos o valor da célula da iteração do loop a variável ValC, e criamos uma condicional para determinar se o valor é par ou impar
```
ValC = Sheets("SVBA_Gabarito").Cells(j, 1).Value
If ValC Mod 2 = 1 Then 'Ímpares
```
Exportamos os valores ímpares de ValC elevados aos quadrado para a planilha "SVBA_Exportar". Note que usamos Offset para evitar que hajam células vazias na lista transferida de números impares Sheets("SVBA_Exportar").Cells(3, 2).Offset(, p).Value = (ValC) ^ 2

Configuramos o layout das células nas quais os dados estão sendo plotados

With Sheets("SVBA_Exportar").Cells(3, 2).Offset(, p)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlHairline
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlHairline
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlHairline
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlHairline
End With

Incrementamos o valor de p para cada dado plotado a fim de manter a ordem da sequência sem células vazias
```
p = p + 1
```

Agora faremos o mesmo processo com os dados pares, seguindo o seu critério

        Else 'Pares
        If ValC > 42 Then 
            Sheets("SVBA_Exportar").Cells(1, 2).Offset(, i).Value = ValC
            With Sheets("SVBA_Exportar").Cells(1, 2).Offset(, i)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlHairline
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlHairline
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlHairline
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlHairline
            End With
            i = i + 1
        End If
    End If
Next j

Terminada a plotagem dos dados, precisamos ordenar os números ímpares elevados ao quadrado em ordem decrescente e os pares acima de 42 em ordem crescente. Determinamos a CurrentRegion dos números pares
```
Set Rng = Sheets("SVBA_Exportar").Cells(1, 2).CurrentRegion
```

Criamos um loop For Next para organizar os dados pares em ordem crescente

For i = 2 To Rng.Count
    For j = i + 1 To Rng.Count
    If Rng.Cells(j) < Rng.Cells(i) Then
        temp = Rng.Cells(i)
        Rng.Cells(i) = Rng.Cells(j)
        Rng.Cells(j) = temp
    End If
    Next j
Next i

Determinamos a CurrentRegion dos números ímpares

Set Rng = Sheets("SVBA_Exportar").Cells(3, 2).CurrentRegion

Criamos um loop For Next para organizar os dados ímpares em ordem decrescente

For i = 2 To Rng.Count
    For j = i + 1 To Rng.Count
    If Rng.Cells(j) > Rng.Cells(i) Then
        temp = Rng.Cells(i)
        Rng.Cells(i) = Rng.Cells(j)
        Rng.Cells(j) = temp
    End If
    Next j
Next i

Código Consolidado

    Sub Plotar_Valores()

    Dim ValC As Variant
    Dim i As Integer

    i = 2
    Do
        ValC = InputBox("Insira um número" & vbCrLf & vbCrLf & "Clique em Ok ou Cancel com a entrada vazia quando tiver terminado.", "SuperExcelVBA")
        If Not IsNumeric(ValC) Then
            If ValC = vbNullString Then
                Exit Do
            End If
            MsgBox "Insira conteúdo numérico", vbCritical, "SuperExcelVBA"
        Else
            If CInt(ValC) <> ValC Then
            MsgBox "Insira apenas números inteiros", vbCritical, "SuperExcelVBA"
            Else
            i = i + 1
            Cells(i, 1) = ValC
            With Cells(i, 1)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlHairline
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlHairline
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlHairline
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlHairline
            End With
            End If
        End If
    Loop Until ValC = vbNullString

    End Sub

    Sub Exportar()

    Dim j As Integer
    Dim UltLinha As Long
    Dim ValC As Double
    Dim temp As Long
    Dim p As Integer
    Dim i As Long
    Dim Rng As Range

    UltLinha = Sheets("SVBA_Gabarito").Cells(Rows.Count, 1).End(xlUp).Row

    For j = 3 To UltLinha 'Ímpares
        ValC = Sheets("SVBA_Gabarito").Cells(j, 1).Value
        If ValC Mod 2 = 1 Then
            Sheets("SVBA_Exportar").Cells(3, 2).Offset(, p).Value = (ValC) ^ 2
            With Sheets("SVBA_Exportar").Cells(3, 2).Offset(, p)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlHairline
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlHairline
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlHairline
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlHairline
            End With
            p = p + 1
            Else
            If ValC > 42 Then 'Pares
                Sheets("SVBA_Exportar").Cells(1, 2).Offset(, i).Value = ValC
                With Sheets("SVBA_Exportar").Cells(1, 2).Offset(, i)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlHairline
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlHairline
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlHairline
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlHairline
                End With
                i = i + 1
            End If
        End If
    Next j

    Set Rng = Sheets("SVBA_Exportar").Cells(1, 2).CurrentRegion

        For i = 2 To Rng.Count
            For j = i + 1 To Rng.Count
            If Rng.Cells(j) < Rng.Cells(i) Then
                temp = Rng.Cells(i)
                Rng.Cells(i) = Rng.Cells(j)
                Rng.Cells(j) = temp
            End If
            Next j
        Next i

    Set Rng = Sheets("SVBA_Exportar").Cells(3, 2).CurrentRegion

        For i = 2 To Rng.Count
            For j = i + 1 To Rng.Count
            If Rng.Cells(j) > Rng.Cells(i) Then
                temp = Rng.Cells(i)
                Rng.Cells(i) = Rng.Cells(j)
                Rng.Cells(j) = temp
            End If
            Next j
        Next i

    End Sub

Exibir Resposta

Download do exercício Download da resposta

SuperExcelVBA.com é um site voltado ao aprendizado de VBA. Exemplos e explicações podem ter sido simplificados para maior e mais veloz compreensão. Estamos constantemente nos atualizando e corrigindo erros, porém não existe garantia sobre o conteúdo disponível no site. Todos os direitos reservados.

Excel ® é uma marca registrada da Microsoft Corporation.

INTRODUÇÃO

BÁSICO

INTERMEDIÁRIO

AVANÇADO