Se puede simplificar código de select case?

Visor · el 20 de mayo

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 · el 20 de mayo

(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 · el 20 de mayo

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