Ayuda con errores en tiempo de ejecución Excel Macros

Ir abajo

Ayuda con errores en tiempo de ejecución Excel Macros

Mensaje  chuyman el Lun Feb 24, 2014 5:40 am

Hola a todos.
Soy nuevo en el foro y espero que me puedan ayudar. De verdad se los agradecería mucho.
Tengo un sistema en excel macros al que me pidieron hacerle algunos algunos ajustes ya que un alguien lo entrego para la empresa donde trabajo sin funcionar del todo bien. El problema es que uno de los módulos muestra 2 errores, uno es el error 13 y el otro es un error 1004, ambos de tiempo de ejecución y la verdad es que, aunque me asignaron a mi el arreglo del sistema, mi especialidad no es visualbasic, así que estoy extremadamente perdido y no se como solucionar dichos errores.
Esta parte del sistema consiste en 3 combobox que filtran información en una base de datos que esta en una hoja de excel y de acuerdo a las opciones que se seleccionen en los combobox, se va cargando la información en un Listbox. El error 13 en tiempo de ejecución se presenta cuando selecciono en el combobox2 alguna opción que devuelve 1 o 0 registros pero no encuentro que debo modificar para solucionarlo y el error 1004 en tiempo de ejecución aparece al seleccionar algunas de las opciones del combobox2 y del combobox3, pero en realidad desconozco cual es el motivo por el que aparece.
A continuación agrego el código:
Código:
Option Explicit
Dim FArray As Variant
Dim DataList As Range, cel As Range, Rng As Range
Dim MyList As String
Dim ws As Worksheet
Dim v, e

Private Sub UserForm_Initialize()
    Dim Found As Long, i As Long
Sheets("INVENTORY").Select
    Sheets("INVENTORY").AutoFilterMode = False
    MyList = "INVDATA"


    Set DataList = Range(MyList).Columns(1)
    DataList.Select

    Set DataList = Selection
    ReDim FArray(DataList.Cells.Count)
    i = -1
    For Each cel In DataList
        On Error Resume Next
        Found = Application.WorksheetFunction.Match(cel, FArray, 0)
        If Found > 0 Then GoTo Exists
        i = i + 1
        FArray(i) = cel
Exists:
        Found = 0
    Next
    ReDim Preserve FArray(i)
    Call BubbleSort(FArray)
    ComboBox1.ListRows = i + 1
    ComboBox1.List() = FArray

End Sub

Private Sub ComboBox1_Change()
    With Me.ListBox1
        .RowSource = ""
    End With

    Flag = True
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear

    Set ws = Sheets("INVENTORY")
    With ws
        If Not ActiveSheet.AutoFilterMode Then
            ActiveSheet.Range("A1").AutoFilter
        End If
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=2
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=1, Criteria1:=Me.ComboBox1.Value
        Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)

        For Each cel In Rng
            With Me.ListBox1
                .AddItem cel.Value
                .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
                .List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
                .List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
                .List(.ListCount - 1,  = cel.Offset(0, 8).Value
                .List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
            End With
        Next cel

        Set Rng = .Range("INVDATA").Columns(2).SpecialCells(xlCellTypeVisible)
        For Each cel In Rng
            With Me.ComboBox2
                .AddItem cel.Offset(0, 0).Value
            End With
        Next cel
    End With
    Flag = False
    

With Sheets("INVENTORY").Range("B3", Sheets("INVENTORY").Range("B65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
     v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .Exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.ComboBox2.List = Application.Transpose(.keys)
End With

End Sub

Private Sub ComboBox2_Click()
    If Flag = True Then Exit Sub
    ComboBox3.Clear
    ComboBox4.Clear
    Me.ListBox1.Clear

    Set ws = Sheets("INVENTORY")
    With ws
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=2, Criteria1:=Me.ComboBox2.Value
        Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)

        For Each cel In Rng
            With Me.ListBox1
                .AddItem cel.Value
                .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
                .List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
                .List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
                .List(.ListCount - 1,  = cel.Offset(0, 8).Value
                .List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
            End With
        Next cel

        Set Rng = .Range("INVDATA").Columns(3).SpecialCells(xlCellTypeVisible)
        For Each cel In Rng
            With Me.ComboBox3
                .AddItem cel.Offset(0, 0).Value
            End With
        Next cel
    End With
    
 
With Sheets("INVENTORY").Range("C3", Sheets("INVENTORY").Range("C65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
    v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .Exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.ComboBox3.List = Application.Transpose(.keys)
End With
    
End Sub

Private Sub ComboBox3_Click()
    If Flag = True Then Exit Sub
    ComboBox4.Clear
    Me.ListBox1.Clear

    Set ws = Sheets("INVENTORY")
    With ws
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=4
        .Range(("A1"), .Range("A1").End(xlDown)).AutoFilter Field:=3, Criteria1:=Me.ComboBox3.Value
        Set Rng = .Range("INVDATA").Columns(1).SpecialCells(xlCellTypeVisible)

        For Each cel In Rng
            With Me.ListBox1
                .AddItem cel.Value
                .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = cel.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = cel.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = cel.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = cel.Offset(0, 5).Value
                .List(.ListCount - 1, 6) = cel.Offset(0, 6).Value
                .List(.ListCount - 1, 7) = cel.Offset(0, 7).Value
                .List(.ListCount - 1,  = cel.Offset(0, 8).Value
                .List(.ListCount - 1, 9) = cel.Offset(0, 9).Value
            End With
        Next cel

        Set Rng = .Range("INVDATA").Columns(4).SpecialCells(xlCellTypeVisible)
        For Each cel In Rng
            With Me.ComboBox4
                .AddItem cel.Offset(0, 0).Value
            End With
        Next cel
    End With
End Sub

Sub BubbleSort(MyArray As Variant)

    Dim First As Integer
    Dim Last As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Temp As String

    First = LBound(MyArray)
    Last = UBound(MyArray)
    For i = First To Last - 1
        For j = i + 1 To Last
            If MyArray(i) > MyArray(j) Then
                Temp = MyArray(j)
                MyArray(j) = MyArray(i)
                MyArray(i) = Temp
            End If
        Next j
    Next i
End Sub

A continuación, les adjunto una captura de pantalla de la hoja de calculo en la que esta almacenada la información.


El "INVDATA" que aparece en el código, se refiere a la siguiente formula:
=DESREF(INVENTORY!$A$3;0;0;(CONTARA(INVENTORY!$A:$A)-2);10)

De verdad les agradecería su ayuda.

chuyman

Cantidad de envíos : 1
Fecha de inscripción : 24/02/2014

Ver perfil de usuario

Volver arriba Ir abajo

Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.