Porque la numeración automática cuando termino de eliminar el último registro me queda 1 en mi excel

Expertos tengo un formulario en excel la cual me trabaja todo perfecto me guarda, me elimina el registro, el formulario programado tiene un módulo de Numeración la cual lo jalo, lo que hace este módulo cuando por ejemplo si tuviera registros 1,2,3,4,5 y elimino la posición 3 la macros lo automatiza y lo deja 1,2,3,4 ya que elimine un registro hasta allí todo perfecto, mi problema es que cuando elimino el ultimo registro me queda este bendito numero 1 en mi excel lo cual también lo carga en mi lisbox y no se que se debe he tratado de hacer de todo pero no he logrado eliminarlo por completo.

Adjunto imagen de prueba.

y esta otra imagen es cuando termino de eliminar los registro y así queda

2 respuestas

Respuesta
1

H0la Cristian:

El 1 sale de acá Range("A7").Value = 1 lo marqué en negrita dentro del código.

Sub OrdenItemEspecialidad()
  On Error GoTo error
  Dim ContNum As Long
  Dim ultimalinea As Long
  ultimalinea = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  Range("A7").Select
  ContNum = 0
  Do Until ContNum = 2 Or ActiveCell.Value = ""
    If ActiveCell.Value <> "" Then
      ContNum = ContNum + 1
      ActiveCell.Offset(1, 0).Select
    End If
  Loop
  If ContNum = 2 Then
    Range("A7").Value = 1
    Range("A8").Value = 2
    Range("A7:A8").Select
    Selection.AutoFill Destination:=Range("A7:A" & ultimalinea)
  Else
     Range("A7").Value = 1
  End If
  Exit Sub
  error:
End Sub

[email protected]

¡Gracias! 

Eso sí experto Isaac Reyes el detalle es porque no se elimina por completo cuando le doy al botón eliminar osea elimina los registros bien pero cuando queda un registro y lo elimino siempre queda ese 1 lo cual también me lo carga en mi listbox, la pregunta es se puede eliminar ese 1 definitivamente porque si elimino un registro por completo se supone que no debe quedar nada o no se puede con esa macros realmente.

Saludos

O la solución sería que al else rango("A7").values=""

Lo dejé en vacío no sé si sea o correcto oe equivoco aunque todavía no lo he probado no sé si estoy bien mal.

Saludos

En realidad, si es correcto o no, eso depende de lo que quisiste hacer con esa línea. En lo particular, simplemente yo eliminaría esa línea y el Else que la precede, pero como te digo, depende de lo que tú hayas querido lograr.

[email protected]

¡Gracias! Mi objetivo era la numeración automatizada en el ingreso de un registro cualquiera de tal manera que cuando haga una modificación, eliminacion reinicie la numeración como le puse en el ejemplo si tengo registros 1,2,3 y elimino el registro 2 la macro lo que hace es dejar 1,2 más no 1,3 y mi inconveniente final era que me quedaba ese 1 al final .

Como te digo, si eliminas el Else y esa línea, no debieras tener problemas.

Pruébalo y me comentas.

[email protected]

¡Gracias! 

Excelente Isaac Reyes, ya probé ahora si funciona todo correctamente muchas gracias.

Saludos.

Respuesta
-1

[Hola Cristian. Puedes hacer una captura de la macro?

¡Gracias! 

Ese es el código fuente el programa corre todo perfecto guarda, elimina, el único inconveniente que tengo es que cuando elimino el ultimo registro queda ese bendito numero 1 en el excel.

'Numeracion automática de las especialidades
Sub OrdenItemEspecialidad()
On Error GoTo error
Dim ContNum       As Long
Dim ultimalinea     As Long
ultimalinea = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A7").Select
ContNum = 0
    Do Until ContNum = 2 Or ActiveCell.Value = ""
        If ActiveCell.Value <> "" Then
            ContNum = ContNum + 1
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
    If ContNum = 2 Then
        Range("A7").Value = 1
        Range("A8").Value = 2
        Range("A7:A8").Select
        Selection.AutoFill Destination:=Range("A7:A" & ultimalinea)
    Else
        Range("A7").Value = 1
    End If
Exit Sub
error:
End Sub
Private Sub Guarda_Especialidad()
On Error GoTo error
Dim ContCodigo, ContItem As Long
        Sheets("Especialidad").Select
        Range("A1").Select
        'Buscar la primera celda vacía
        Application.GoTo Reference:="R65000C1"
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        'Genera Item
        If ActiveCell.Offset(-0, 1) = "Item" Then
            ContItem = 1
        Else
            ContItem = ActiveCell.Offset(-0, 1) + 1
        End If
        'Corregir datos
        ActiveCell.Offset(0, 0).Value = ContItem
        ActiveCell.Offset(0, 1).Value = TxtEspecialidad
        ActiveCell.Offset(0, 2).Value = TxtCantidad
        Call OrdenItemEspecialidad
        Call LimparCamposEspecialidad
        Call CargarListaEspecialidad
        MsgBox "Postulante registrado con éxito!", vbInformation, "Cadastro"
Exit Sub
error:
End Sub
Sub CargarListaEspecialidad()
On Error GoTo error
Dim arrayItems()
Dim VResultado                                                      As Boolean
Dim linea, columna, Cont, NItem, Nlineas, ContItem, ColocaItem       As Long
Dim MyList
Cont = 1
NItem = 0
Nlineas = Sheets("Especialidad").Range("A100").End(xlUp).Row 'Cuenta número de lineas existentes
If Nlineas = 1 Then
Else
    ReDim arrayItems(1 To Nlineas, 1 To Sheets("Especialidad").UsedRange.Columns.Count)
    With Me.LstEspecialidad
                .Clear
                .ColumnCount = 3
                .ColumnWidths = "30; 360; 50"
        With Sheets("Especialidad")
        MyList = .Range("A1:A" & Nlineas)
            For linea = 7 To UBound(MyList)
                'Limpia memoria
                VResultado = False
                VResultado = .Range("B" & linea).Value Like "*" + "*"
                If VResultado Then
                    Me.LstEspecialidad.AddItem
                    For columna = 1 To 3
                       arrayItems(Cont, columna) = .Cells(linea, columna).Value
                    Next columna
                    Cont = Cont + 1
               End If
            Next linea
            Me.LstEspecialidad.List = arrayItems()
        End With
    End With
End If
Exit Sub
error:
End Sub
Private Sub EliminarEspecialidad()
On Error GoTo error
    If lineaSelecionadaEspecialidad = 0 Then
        MsgBox "Selecione una Especialidad!", vbExclamation, "Eliminar"
    Exit Sub
    ElseIf MsgBox("Desea realmente continuar?", vbQuestion + vbYesNo, "Eliminar") = vbYes Then
    Sheets("Especialidad").Select
    'Procedimento que localiza a linea
    EncontrarEspecialidad = lineaSelecionadaEspecialidad
        If Trim(EncontrarEspecialidad) <> "" Then
            With Sheets("Especialidad").Range("A:A")
                Set EncontrarCelula = .Find(what:=EncontrarEspecialidad, _
                                after:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not EncontrarCelula Is Nothing Then
                    Application.GoTo EncontrarCelula, True
                    'Eliminar linea
                    ActiveCell.Offset(0, 0).Rows.EntireRow.Delete
                    LstEspecialidad.Clear
                    Call OrdenItemEspecialidad
                    Call LimparCamposEspecialidad
                    Call CargarListaEspecialidad
                    MsgBox "Especialidad excluído con éxito!", vbInformation, "Eliminar"
                End If
            End With
        End If
    End If
Exit Sub
error:
End Sub
Private Sub BtnCancelar_Click()
On Error GoTo error
    Call LimparCamposEspecialidad
    Call CargarListaEspecialidad
Exit Sub
error:
End Sub
Private Sub BtnEliminar_Click()
Call EliminarEspecialidad
End Sub
Private Sub BtnGuardar_Click()
On Error GoTo error
        Call Guarda_Especialidad
Exit Sub
error:
End Sub
Private Sub LstEspecialidad_Click()
On Error GoTo error
    If LstEspecialidad.Column(0) <> "" Then
        lineaSelecionadaEspecialidad = LstEspecialidad.Column(0)
        TxtEspecialidad.Enabled = True
        TxtCantidad.Enabled = True
        TxtEspecialidad = LstEspecialidad.Column(1)
        TxtCantidad = LstEspecialidad.Column(2)
        BtnGuardar.Enabled = False
        BtnEliminar.Enabled = True
        BtnCancelar.Enabled = True
    Else
        Call LimparCamposEspecialidad
        TxtEspecialidad.Enabled = False
        TxtCantidad.Enabled = False
        BtnGuardar.Enabled = False
        BtnEliminar.Enabled = False
        BtnCancelar.Enabled = False
    End If
Exit Sub
error:
End Sub
Private Sub UserForm_Initialize()
On Error GoTo error
        Call CargarListaEspecialidad
Exit Sub
error:
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas