|
Tal vez te sirva este código que hice para un programa; la macro revisa los CÓDIGOS ingresados en la columna A, y me muestra en B1 los códigos y rangos de códigos disponibles:
(Ingresa tu lista en A:A y ejecuta la macro "ingresarnuevo".
Public Function nuevocod(codigo As Integer) As Boolean
Application.ScreenUpdating = False
'Application.Goto Reference:="code"
Range("A:A").Select
Set celda = Selection.Find(What:=codigo, LookAt:=xlWhole)
If Not celda Is Nothing Then
nuevocod = False
Else
nuevocod = True
End If
End Function
Sub ingresarnuevo()
Dim cadena As String
Dim ante As Integer
Dim i As Integer
Dim j As Integer
Dim dispo(999) As Integer
For i = 1 To 999
If nuevocod(i) Then
dispo(j) = i
j = j + 1
End If
Next i
'dispo(j) = 1000
[a1].Select
j = 1
If dispo(0) > 0 Then
cadena = dispo(0)
While dispo(j) > 0
If dispo(j - 1) + 1 = dispo(j) And dispo(j + 1) - 1 <> dispo(j) Then
cadena = cadena & "-" & dispo(j) & "; "
ElseIf dispo(j - 1) + 1 <> dispo(j) And dispo(j + 1) - 1 <> dispo(j) Then
cadena = cadena & dispo(j) & "; "
ElseIf dispo(j - 1) + 1 <> dispo(j) And dispo(j + 1) - 1 = dispo(j) Then
cadena = cadena & dispo(j)
End If
'If dispo(j + 1) = 1000 Then cadena = cadena & dispo(j)
j = j + 1
Wend
Cells(1, 2) = Mid(cadena, 1, Len(cadena) - 3)
End If
End Sub
Carlos A. Leal P.
|
