Separate Even, Odd and Equal values in Matrix by VBA (Excel)

Question

how to make a 10x10 matrix, separate pairs and odd and equal without using Mod ?

Answer 1

NOW WITH CODE READY AND TESTED!

To solution presented in the code below treats each element of the matrix at a time to identify the numbers pairs and odd contained in it. In the sequence, within the order of analysis per element of the matrix, there is also the verification of how many values are equal (considering the total amount that each repeated number is in the matrix) and how many numbers are Repeated (if you want to distinguish "equal" from "repeated" as I did, otherwise your "equal" is my "repeated"):

Option Explicit

Private Sub UserForm_Initialize()

    SepararValores

End Sub

Private Sub SepararValores()

    Dim Matriz(10, 10), Pares(100), Impares(100), Iguais(100) As String

    Dim Qtde_Pares, Qtde_Impares, Qtde_Iguais, _
        MenorNumeroInteiro, MaiorNumeroInteiro, _
        NumeroDeLinhas, NumeroDeColunas, _
        i, j, s, t, k, Aux_IndiceIguais As Integer

    Dim Aux_String, Linha As String

    Dim OcorrenciaDeNumerosIguais As Boolean

    Aux_String = ""

    NumeroDeLinhas = 10 'A matriz está dimensionada para ser no máximo 10 x 10, mas pode alterar o dimensionamento se precisar.
    NumeroDeColunas = 10

    MenorNumeroInteiro = 1
    MaiorNumeroInteiro = 99

    Aux_String = " Matriz " & NumeroDeLinhas & " x " & NumeroDeColunas

    Debug.Print ""
    Debug.Print Aux_String
    Debug.Print " " & Left("--------------------", Len(Aux_String) - 1)
    Debug.Print ""

    Linha = ""

    Randomize

    'Preenche a matriz
    For i = 1 To NumeroDeLinhas

        For j = 1 To NumeroDeColunas

            Matriz(i, j) = CStr(Int((MaiorNumeroInteiro - MenorNumeroInteiro + 1) * Rnd()) + MenorNumeroInteiro)

            If Len(CStr(Matriz(i, j))) < 2 Then Matriz(i, j) = "0" & Matriz(i, j)

            Linha = Linha & " " & Matriz(i, j)

        Next j

        Debug.Print Linha

        Debug.Print ""

        Linha = ""

    Next i

    Debug.Print ""
    Debug.Print " Solução"
    Debug.Print " -------"
    Debug.Print ""

    Qtde_Pares = 0
    Qtde_Impares = 0
    Qtde_Iguais = 0

    Aux_IndiceIguais = 0 'Indice para registro dos números Iguais

    'Trata cada elemento da matriz por vez, para achar os
    'Pares, Ímpares e os Iguais
    For i = 1 To NumeroDeLinhas

        For j = 1 To NumeroDeColunas

            If Int(Matriz(i, j) / 2) - Matriz(i, j) / 2 = 0 Then
              'Se é Par

               Qtde_Pares = Qtde_Pares + 1

               Pares(Qtde_Pares) = Matriz(i, j)

            Else
              'Se é Ímpar

               Qtde_Impares = Qtde_Impares + 1

               Impares(Qtde_Impares) = Matriz(i, j)

            End If

            'Calcula a quantidade de valores iguais na matriz
            'Sem refazer para um mesmo valor

            OcorrenciaDeNumerosIguais = False

            For s = 1 To NumeroDeLinhas

                For t = 1 To NumeroDeColunas

                    'Faz se encontrou um valor igual, mas que
                    '"i" e "j" não sejam iguais a "s" e "t" simultaneamente
                    If Matriz(s, t) = Matriz(i, j) And (s <> i Or t <> j) Then

                        'Faz se é um valor não encontrado anteriormente
                        If s > i Or (s = i And t > j) Then

                            Qtde_Iguais = Qtde_Iguais + 1

                            If Not OcorrenciaDeNumerosIguais Then

                                OcorrenciaDeNumerosIguais = True

                                Qtde_Iguais = Qtde_Iguais + 1
                                'Soma mais um pois deve considerar o
                                'próprio número procurado

                                'Fica com a quantidade de números repetidos
                                Aux_IndiceIguais = Aux_IndiceIguais + 1

                                Iguais(Aux_IndiceIguais) = Matriz(i, j)

                            End If

                        Else

                           'Se é um valor já considerado anteriormente,
                           'deve ignorá-lo e já passar a pegar o próximo,
                           'senão duplicaria várias vezes este resultado,
                           'pois já pegou todos da primeira vez

                           GoTo Sair_deste_loop

                        End If

                    End If

                Next t

            Next s

        Sair_deste_loop:

        Next j

    Next i

    'Parte da impressão de daodos
    'Use a Janela de Verificação Imediata do VBA
    'Para ver a matriz e os respectivos resultados

    Linha = ""

    For i = 1 To Qtde_Pares

        Linha = Linha & " " & Pares(i)

    Next i

    Debug.Print " " & Qtde_Pares & " números Pares:" & Linha
    Debug.Print ""

    Linha = ""

    For i = 1 To Qtde_Impares

        Linha = Linha & " " & Impares(i)

    Next i

    Debug.Print " " & Qtde_Impares & " números Ímpares:" & Linha
    Debug.Print ""

    Linha = ""

    For i = 1 To Aux_IndiceIguais

        Linha = Linha & " " & Iguais(i)

    Next i

    Debug.Print " " & Qtde_Iguais & " números Iguais:" & Linha
    Debug.Print ""
    Debug.Print " " & Aux_IndiceIguais & " números Repetidos."
    Debug.Print ""

    Beep

End Sub