Volcar datos mediante un Combobox sin duplicados

Estoy empezando a descubrir las grandes posibilidades de Excel y desearía me ayudéis en el trabajo que estoy empezando.

Dispongo de 2 hojas: Base y Vista

En la hoja Base sólo los datos de la columna A y H están relacionados entre sí

En la hoja Vista es donde tengo un combobox y aquí deseo se vuelquen los datos

Al seleccionar un elemento del combobox se volcarán los datos del rango A:K de la hoja Base a la hoja Vista, a partir de la fila 60.

En el combox deben aparecer los elementos de la columna H (sin duplicados), cuando sus correspondientes celdas de la columna K no están vacios

Ejemplo. En la hoja Base

COLUMNAS: A B H I K

1 B1 H1 I1

2 B2 H2 I2 K2

2 B3 H2 I3 K3

2 B4 H2 I4 K4

3 B5 H3 I5

4 B6 H4 I6 K6

En el combobox, de la hoja Vista, aparecerán: H2, H4 y al seleccionar, por ejem H2 se volcarán los datos de los rangos A2:K2, A3:K3, A4:K4 a la hoja Vista a partir de la fila 60. Si se seleccionara H6, se volcaría el rango A6:K6

Lo que necesito es la secuencia para poder realizar lo expuesto

2 Respuestas

Respuesta
1

Te anexo las siguientes macros:

Pon la siguiente macro en los eventos de workbook

Private Sub Workbook_Open()
'Por.Dante Amor
    Sheets("Vista").Activate
End Sub

Instrucciones para poner la macro en los eventos ThisWorkbook

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
  4. Del lado derecho copia la macro

Pon las siguientes en los eventos de worksheet

Private Sub ComboBox1_Change()
'Por.Dante Amor
    Set h1 = Sheets("Base")
    Set r = h1.Columns("H")
    Set b = r.Find(ComboBox1, lookat:=xlWhole)
    j = 60
    u = Range("H" & Rows.Count).End(xlUp).Row
    If u < 60 Then u = 60
    Range(Cells(j, "A"), Cells(u, "K")).ClearContents
    If Not b Is Nothing Then
        celda = b.Address
        Do
            h1.Range(h1.Cells(b.Row, "A"), h1.Cells(b.Row, "K")).Copy Cells(j, "A")
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
End Sub
Private Sub Worksheet_Activate()
'Por.Dante Amor
    Set h1 = Sheets("Base")
    For i = 1 To h1.Range("H" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "K") <> "" Then
            agregar ComboBox1, h1.Cells(i, "H")
        End If
    Next
End Sub
Sub agregar(combo As ComboBox, dato As String)
'Por.Dante Amor
    For i = 0 To combo.ListCount - 1
        Select Case StrComp(combo.List(i), dato, vbTextCompare)
            Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
            Case 1: combo.AddItem dato, i: Exit Sub 'Es menor, lo agrega antes del comparado
        End Select
    Next
    combo.AddItem dato 'Es mayor lo agrega al final
End Sub

Sigue las Instrucciones para poner la macro en los eventos de worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro


En la hoja "Vista" deberás tener un combo de control Activex, llamado "ComboBox1".


Hola Dante Amor.

Felices Fiestas

Gracias por el aporte, pero resulta que al pasar de la hoja Base a la hoja Vista, ésta se queda bloqueada durante un tiempo. Después sí funciona bien. Qué podrá ser?

Cuando seleccionas la hoja "Vista", se empieza a cargar el combo, esto es necesario que se haga por si hiciste cambios en la hoja "Base".

Cambia las macros por esta, pero antes crea una hoja llamada "Datos", esta hoja es necesaria para poner los datos sin duplicados.

Private Sub ComboBox1_Change()
'Por.Dante Amor
    Set h1 = Sheets("Base")
    Set r = h1.Columns("H")
    Set b = r.Find(ComboBox1, lookat:=xlWhole)
    j = 60
    u = Range("H" & Rows.Count).End(xlUp).Row
    If u < 60 Then u = 60
    Range(Cells(j, "A"), Cells(u, "K")).ClearContents
    If Not b Is Nothing Then
        celda = b.Address
        Do
            h1.Range(h1.Cells(b.Row, "A"), h1.Cells(b.Row, "K")).Copy Cells(j, "A")
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
End Sub
Private Sub Worksheet_Activate()
'Por.Dante Amor
    Set h1 = Sheets("Base")
    Set h2 = Sheets("Datos")
    h2.Cells.Clear
    h1.Range("H:H,K:K").Copy h2.Range("A1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Range("B1:B" & u).SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp
    h2.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlNo
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    ComboBox1.ListFillRange = h2.Name & "!A1:A" & u
End Sub

Hola

Sigue tardando en cargarse y además me señala error 1004 en la línea:

  Set b = r.Find(ComboBox1, lookat:=xlWhole)

Entonces utiliza la primer macro.

Debido a que tienes varios datos y quieres validar que sean datos únicos y además en la columna K sean diferentes de "", es por eso que se tarda en cargarse.

Respuesta
1

Al pasar de la hoja Base a la hoja Vista, ésta se queda bloqueada durante unos 15 segundos. Después ya funciona correctamente

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas