Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Se puede simplificar código de select case?

Visor

Por Visor
en Macros y programación VBA

Recommended Posts

Visor Aprendiz

Visor

publicado
publicado

Saludos amigos del foro, ahora me he puesto a pensar que puede simplificarse un código que uso para borrar el contenido de ciertas columnas. Si en el texbox1 coloco el 5 se borra todo el contenido de esa columna, en el rango indicado. Pero me parece que todo ese código es muy largo. 

Tengo 20 columnas en cada uno lleva informacion que en cierto tiempo puedo decidir borrar todo el contenido de una de las columnas.

Expongo el código para saber si es posible encontrar un código mas corto que haga los mismo. Pro ejemplo veo que el mensaje puede ser solo 1 y cada vez lo que cambia es el numero de columna igualmente ocurre cuando se decide cancelar el borrado, y así por el estilo:

El codigo: 

Private Sub CmdBorrarCol_Click()
Dim nCol As Integer
 If TextBox1 = "" Then Exit Sub
nCol = TextBox1.Value

Select Case nCol

Case 1
 If MsgBox("Se va a borrar todo el contenido de la columna 1, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
     Range("C6:C77").ClearContents
    TextBox1 = ""
    
    Case 2
     If MsgBox("Se va a borrar todo el contenido de la columna 2, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("D6:D77").ClearContents
        TextBox1 = ""
    Case 3
     If MsgBox("Se va a borrar todo el contenido de la columna 3, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("E6:E77").ClearContents
        TextBox1 = ""
    Case 4
     If MsgBox("Se va a borrar todo el contenido de la columna 4, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("F6:F77").ClearContents
        TextBox1 = ""
    Case 5
     If MsgBox("Se va a borrar todo el contenido de la columna 5, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("G6:G77").ClearContents
        TextBox1 = ""

    Case 6
     If MsgBox("Se va a borrar todo el contenido de la columna 6, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("H6:H77").ClearContents
        TextBox1 = ""

    Case 7
     If MsgBox("Se va a borrar todo el contenido de la columna 7, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("I6:I77").ClearContents
        TextBox1 = ""
    Case 8
     If MsgBox("Se va a borrar todo el contenido de la columna 8, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("J6:J77").ClearContents
        TextBox1 = ""
    Case 9
     If MsgBox("Se va a borrar todo el contenido de la columna 9, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("K6:K77").ClearContents
        TextBox1 = ""
    Case 10
     If MsgBox("Se va a borrar todo el contenido de la columna 10, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("L6:L77").ClearContents
        TextBox1 = ""
Case 11
 If MsgBox("Se va a borrar todo el contenido de la columna 11, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
     Range("M6:M77").ClearContents
    TextBox1 = ""
    
    Case 12
     If MsgBox("Se va a borrar todo el contenido de la columna 12, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("N6:N77").ClearContents
        TextBox1 = ""
    Case 13
     If MsgBox("Se va a borrar todo el contenido de la columna 13, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("O6:O77").ClearContents
        TextBox1 = ""
    Case 14
     If MsgBox("Se va a borrar todo el contenido de la columna 14, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("P6:P77").ClearContents
        TextBox1 = ""
    Case 15
     If MsgBox("Se va a borrar todo el contenido de la columna 15, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("Q6:Q77").ClearContents
        TextBox1 = ""

    Case 16
     If MsgBox("Se va a borrar todo el contenido de la columna 16, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("R6:R77").ClearContents
        TextBox1 = ""

    Case 17
     If MsgBox("Se va a borrar todo el contenido de la columna 17, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("S6:S77").ClearContents
        TextBox1 = ""
    Case 18
     If MsgBox("Se va a borrar todo el contenido de la columna 18, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("T6:T77").ClearContents
        TextBox1 = ""
    Case 19
     If MsgBox("Se va a borrar todo el contenido de la columna 19, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("U6:U77").ClearContents
        TextBox1 = ""
    Case 20
     If MsgBox("Se va a borrar todo el contenido de la columna 20, Presione Aceptar para continuar.", vbOKCancel, "Excel123") = vbCancel Then
        MsgBox "Has cancelado el borrado de la columna"
        Exit Sub
    End If
    'MsgBox "Se procede a borrar."
    Range("V6:V77").ClearContents
        TextBox1 = ""
End Select
End Sub

Agradezco su gentil apoyo en colaborar en este tema

Héctor Miguel Gran colaborador

Héctor Miguel

publicado
publicado

(p.ej.) 

Private Sub CmdBorrarCol_Click()
  Dim nCol As Integer, rangoBorrar As String
  If TextBox1 = "" Then Exit Sub Else nCol = TextBox1.Value
  Select Case nCol
    Case 1 To 20
      rangoBorrar = Range("b6:b77").Offset(, nCol).Address
      If MsgBox("Se va a borrar el contenido de la columna " & nCol & vbCr & _
        "Presiona ""Aceptar"" para continuar", vbOKCancel, "") = vbCancel Then
          MsgBox "Operacion cancelada por el usuario"
          Exit Sub
      End If
      Range(rangoBorrar).ClearContents
      TextBox1 = ""
    Case Else
      MsgBox "El valor introducido en el control de texto NO es válido !!!"
  End Select
End Sub

saludos,

hector.

Visor Aprendiz

Visor

publicado
  • Autor
publicado

Ya veo!! La clave offset, .....a partir de la columna B se ubica automáticamente en la posición nCol que se le haya puesto en el textbox1 que lo toma como rango a borrar en la variable rangoborrar. En caso de introducir un valor fuera del 1-20 me advierte y termina la instrucción, esto ultimo no lo tenia en el código subido y si que es importante.

Efectivamente simplificado

Gracias por este apoyo. Quedo perfecto y he podido usar este modo para corregir otros códigos similares.

Tema solucionado

  • Silvia bloqueó este tema

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Tilin2023
      Contar días Consecutivos desde el último día.

      Por Tilin2023 · publicado

      Estimados buenos días, Quisiera saber si me pueden brindar su soporte con lo siguiente. Tengo lo siguiente una data de FECHAS CON CANTIDADES y quisiera saber si hay alguna formula para poder contabilizar desde la última fecha cuando días son consecutivos, ejemplo si en una fila queda vacío porque no se repite y la fecha matriz es la ultima fecha quiere decir que no se repite y es 0.   DIAS CONSECUTIVOS.xlsx
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      Buenos días con todo, espero se encuentren bien de salud!. Favor quisiera ver si me pueden ayudar con lo siguiente. Tengo una data en excel con los siguiente criterios FECHAS DIFERENTES , CODIGO Y NOMBRE DEL PRODUCTO. Lo que quiero realizar es que si en la fecha 17-02  tienes cantidad x de códigos y si estos no se repite el día siguiente 18-02 que automáticamente se borre, esto con la finalidad de tener un control de a partir del 18 al 19  se repite 1 vez y no me considere 2 desde fecha 17-02  teniendo en cuenta que el producto en el 18-02 no aparece. Lo sombreado son los que se repiten .   TABLA ELIMINAR.xlsx
    • Enrique González Jiménez
      Ayuda con Congelar Fecha Captura

      Por Enrique González Jiménez · publicado

      Vale mil gracias, en vdd se agradece todo el apoyo y comentarios
    • Abraham Valencia
      Problema (¿Macro?) para guardar Excel en SharePoint

      Por Abraham Valencia · publicado

      Hola nuevamente. Por eso la importancia de lo que mencionas tú como "ruta relativa". Tal cual comentas, y aún sin llegar a algunos detalles importantes para ayudarte, en realidad tal cual te comenté le día miércoles, pues sí podías hacer como comentabas, era cosa de obtener los Id de Windows (como tú los llamas) y la ruta de OneDrive en casa usuario y eso sí se puede obtener con VBA y luego pasarlo a PQ, pero medio que te cerraste en que "PQ no puede trabajar con rutas relativas", cosa cierta pero siempre hay formas. Si SAP puede o no guardar en OneDrive o SharePoint, pues si está mapeado en la PC ¡claro que se puede! Pero bueno, creo que si te es útil tu propia propuesta ¡avanza con eso!
    • njnsp
      Problema (¿Macro?) para guardar Excel en SharePoint

      Por njnsp · publicado

      Perdona @Abraham Valencia pero he estado liado estos días. En realidad todo el problema se reduce a estos dos problemas: Problema 1: El script que "fabrica" SAP y que luego "pego" en la macro, no es capaz de  guardar archivos en SharePoint. He estado buscando, y en realidad muchas personas tienen ese problema (no poder guardar un Excel en SAP a través de VBA). Eso muy probablemente sean problemas de permisos, que no puedo cambiar (no soy administrador de nada). Como no puedo solucionarlo así, paso al plan B, que es guardar en Excel que me genera SAP en el ordenador de cada usuario que ejecute la plantilla (y que sí está guardada en SharePoint), para después con PowerQuery llamar a ese Excel (el export). Para ello, pretendo guardar el export, en la ruta relativa "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" donde los \..\..\..\ saltan las rutas personales de cada usuario (tipo C:\users\IDusuario\). Eso lo hace bien, y el archivo se guarda en la ruta de cada usuario que lo usa, pero surge el problema 2 Problema 2: PowerQuery no trabaja con rutas relativas del tipo  "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" necesita que sea del tipo fija "C:\users\IDusuario\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" pero claro, IDusuario es diferente para cada usuario.   Pero escribiendo todo esto, creo que he dado con una posible solución, no grabar el export en una ruta de usuario, sino en una en la raiz de C:, que siempre será igual para todos los usuarios, del tipo C:\Sap\export.xlsx que seria igual en todos los ordenadores. Asi sí podría decirle a PowerQuery que vaya siempre a la ruta C:\Sap\ que existirá en todos los ordenadores. Mañana intentaré hacer pruebas, aunque mi solución ideal seria que se pudiera guardar en el SharePoint. Saludos.

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.