1 resposta(s) nesse tópico

[RZOZN]

Olá pessoal, estou com um problema que não consigo resolver.
Preciso saber a posição certa para colocar o numero. Exemplo:

Tenho uma matriz:

1, 4, 6, 7, 8, 12, 16, 17, 20, 23

Os numeros que faltam são: 2,3,5,9,10,11,13,14,15,18,19,21,22

O que eu preciso que a planiha faça é o seguinte: Dentro desses numeros que faltam eu vou escoher
4 numeros por exemplo, supondo que seja o 5,10,13,18, agora a planiha tem que procurar a posição
cera onde esses numeros pertencem na matriz.

A matriz: 1, 4, 6, 7, 8, 12, 16, 17, 20, 23

Achando a posição certa para o 5,10,13,18, ficaria: 1, 4, 6, 7, 8, 12, 16, 17, 20, 23,
os números em negrito iriam sumir e entrariam os 4 números escolhidos. 1,5,6,7,10,13,16,18,20,23
Ou seja tem que achar o número antecessor da matriz e alterar de acordo com o conjunto de 4 números escolhidos.

Obrigado pessoal.

[felipebenza]

Sub Exemplo()

    Const c_lNúmeroEscolhidos As Long = 4

   

    Dim vOriginal

    Dim vFaltantes()

    Dim vEscolhidos

    Dim vCópia

   

    Dim lOriginal As Long

    Dim lFaltantes As Long

    Dim lEscolhidos As Long

    Dim lUB As Long

    Dim lLB As Long

   

    vOriginal = Array(1, 4, 6, 7, 8, 12, 16, 17, 20, 23)

    lLB = LBound(vOriginal)

    lUB = UBound(vOriginal)

   

    lFaltantes = lLB

    For lOriginal = vOriginal(lLB) To vOriginal(lUB)

	    If EleOf(lOriginal, vOriginal) = 0 Then

		    ReDim Preserve vFaltantes(lLB To lFaltantes)

		    vFaltantes(lFaltantes) = lOriginal

		    lFaltantes = lFaltantes + 1

	    End If

    Next lOriginal

   

    'O vetor vFaltantes é:

    '2,3,5,9,10,11,13,14,15,18,19,21,22

    'Suponha que os itens escolhidos foram 5,10,13,18, isto é,

    ReDim vEscolhidos(lLB To lLB + c_lNúmeroEscolhidos - 1)

    vEscolhidos(lLB + 0) = 5

    vEscolhidos(lLB + 1) = 10

    vEscolhidos(lLB + 2) = 13

    vEscolhidos(lLB + 3) = 18

   

    vCópia = vOriginal

    For lEscolhidos = LBound(vEscolhidos) To UBound(vEscolhidos)

	    For lOriginal = LBound(vOriginal) To UBound(vOriginal)

		    If vEscolhidos(lEscolhidos) < vOriginal(lOriginal) Then

			    vCópia(lOriginal - 1) = vEscolhidos(lEscolhidos)

			    Exit For

		    End If

	    Next lOriginal

    Next lEscolhidos

    'O vetor vCópia é:

    '1,5,6,7,10,13,16,18,20,23

    MsgBox Join(vCópia, ",")

End Sub

Function EleOf(ByVal vTermo As Variant, ByVal vVetor As Variant) As Long

    'Retorna o número da linha ou coluna de uma célula numa linha ou coluna.

    'Se vVetor for uma Variant(), retorna o índice do elemento no vetor.

    'Caso não seja encontrada nenhuma ocorrência, é retornado 0.

    On Error Resume Next

    Select Case TypeName(vVetor)

	    Case "Range"

		    If vVetor.Columns.Count = 1 Then

			    'vVetor é uma coluna

			    EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Row - 1

		    ElseIf vVetor.Rows.Count = 1 Then

			    'vVetor é uma linha

			    EleOf = WorksheetFunction.Match(vTermo, vVetor, 0) + vVetor.Column - 1

		    End If

	    Case "Variant()"

		    EleOf = WorksheetFunction.Match(vTermo, vVetor, 0)

    End Select

End Function