Aver si por aqui me pueden ayudar:
El enunciado consiste en borra los numeros de una lista que posean mayor cantidad de digitos pares que impares.
El problema que tengo es el siguiente:
N=4
array={1,2,3,4}
array con eliminaciones={1,3}
N=10
array={1,2,3,4,5,6,7,8,9,10}
array con eliminaciones={1,3,4,6,7,9} cuando tendria que ser:
array con eliminaciones={1,3,5,7,9,10}
Y otro error:
array={2,2,5}
array con eliminaciones={2,5}
Es decir cuando existen posiciones iniciales consecutivas, no asi en
array={5,2,2}
array con eliminaciones={5}
Private Sub Form_Load()
cnt_p = 0
cnt_i = 0
Dim lista(100) As Integer
Dim elim(100) As Integer
Label1.Caption = "" 'Array
Label2.Caption = "" 'Array con eliminaciones
Label3.Caption = "" 'Posiciones a eliminar
MsgBox "Inicializacion", vbOKOnly
k = 0
cant = InputBox("Cantidad: ")
N = Val(cant)
For i = 1 To N
entero = InputBox("Numero: ")
num = Val(entero)
lista(i) = num
Next
For i = 1 To N
Label1.Caption = Label1.Caption & lista(i) & ","
Next
For i = 1 To N
d_num = lista(i) 'Separo los digitos
While d_num <> 0
dig = d_num Mod 10
If dig Mod 2 = 0 Then 'Compruebo si son multiplos pares
cnt_p = cnt_p + 1
End If
If dig Mod 2 <> 0 Then
cnt_i = cnt_i + 1
End If
d_num = d_num \ 10
Wend
If cnt_p > cnt_i Then 'Si la cantidad de digitos pares es mayor a las impares
k = k + 1
elim(k) = i 'Array que contiene las posiciones
End If
cnt_p = 0
cnt_i = 0
Next
For i = 1 To k
Label3.Caption = Label3.Caption & elim(i) & ","
Next
For i = 1 To k
pos = elim(i)
For j = pos To (N - 1)
lista(j) = lista(j + 1)
Next
N = N - 1
Next
For i = 1 To N
Label2.Caption = Label2.Caption & lista(i) & ","
Next
End Sub
Solucionado. ::)
Modificaciones:
If cnt_p > cnt_i Then
k = k + 1
elim(k) = i - cnt_elist
cnt_elist = cnt_elist + 1
End If
Salu2!