cargar datos en listbox userform desde una matriz trabajando con vba excel97

05/02/2006 - 12:12 por vdadesolano | Informe spam
Sin tener practicamente idea, sin leer ningun libro sobre la materia, y
a partir de los consejos que he encontrado en este foro y de la
enigmatica ayuda de excel97 vba (soy un antiguo, lo se, pero me
encontre mi ordenador en la basura y es lo que llevaba) me he propuesto
hacer mi primera macro par a Excel. No quiero trabajar con celdas ,
sino con datos cargados en una matriz, que representan la tabla excel
que quiero calcular. El problema actual surge por que quiero cargar en
una user form los datos de una columna , que ahora son variables una
mimatriz(1 to x ,1 to y). Son numeros de telefono y estan repetidos.
Quiero que mi userform lisbox me pregunte que elementos quiero
seleccionar listandos a partir de los existentes pero mostrando los
repetidos solo una vez. Todo esto para devolver los elemento con los
que voy a hacer el calculo y llamar a la matriz para esos elementos y
calcular dentro de la sub y devolver el resultado como msgbox.De
momento voy por aqui.¿Agradeceria cualquier idea?

Dim ArchivoAAbrir As String, ArchivoAAbrirtxt As String
Dim Matriz()
Dim x As Integer
Dim y As Integer
Dim valor
Dim contador As Integer

Sub ABRIR()
'ArchivoAAbrir = Application.GetOpenFilename("Archivos de Microsoft
Excel (*.XLS), *.XLS")
'If ArchivoAAbrir <> False Then
'End If
'UserForm1.Show
Workbooks.Open FileName:="c:\ejemplo.xls" 'ArchivoAAbrir
Worksheets("Hoja1").Activate
Worksheets("Hoja1").Range("a3").Activate
Dim x As Integer
Dim numrows As Integer ' declara numero de filas.
Range("a1").Select 'va a 1ª celda
numrows = Range("a3", Range("a3").End(xlDown)).Rows.Count ' cuenta
filas
numrows = numrows + 2
numcolumns = Range("a3", Range("a3").End(xlToRight)).Columns.Count '
cuenta Columns
ReDim Matriz(1 To numrows, 1 To numcolumns)

For x = 1 To numrows
For y = 1 To numcolumns
valor = Cells(x, y).Value
Matriz(x, y) = valor
Next y
Next x

Stop
End Sub
 

Leer las respuestas

#1 KL
05/02/2006 - 23:20 | Informe spam
Hola vdadesolano,

1) comentarte que el codigo que expones (tal cual) lo realizaria de una de las siguientes formas (es mas eficiente pasar el rango a
matriz directamente que usar bucle)

'Inicio Codigo 1
Sub ABRIR1()
' si NO hay formatos fuera del area de datos
Dim Matriz As Variant, oLibro As Workbook, y As Long
ArchivoAAbrir = Application.GetOpenFilename _
("Archivos de Microsoft Excel (*.XLS), *.XLS")
If ArchivoAAbrir <> False Then
Set oLibro = Workbooks.Open(ArchivoAAbrir)
With oLibro
With .Worksheets("Hoja1").UsedRange
y = .Columns.Count
Matriz = .Offset(2).Resize(.Rows.Count - 2).Value
End With
.Close
End With
With UserForm1
With .ListBox1
.ColumnCount = y
.List() = Matriz
End With
.Show
End With
End If
End Sub
'Fin Codigo 1

'Inicio Codigo 2
' si hay formatos fuera del area de datos
Sub ABRIR2()
Dim Matriz As Variant, oLibro As Workbook, x As Long, y As Long
ArchivoAAbrir = Application.GetOpenFilename _
("Archivos de Microsoft Excel (*.XLS), *.XLS")
If ArchivoAAbrir <> False Then
Set oLibro = Workbooks.Open(ArchivoAAbrir)
With oLibro
With .Worksheets("Hoja1")
x = .Cells(.Rows.Count, "A").End(xlUp).Row
y = .Cells(3, .Columns.Count).End(xlToLeft).Column
Matriz = .Range(.Range("A3"), .Cells(x, y)).Value
End With
.Close
End With
With UserForm1
With .ListBox1
.ColumnCount = y
.List() = Matriz
End With
.Show
End With
End If
End Sub
'Fin Codigo 2

2) Si solo necesitas meter en un listbox los valores unicos de UNA columna (digamos la columna [A]) podrias usar el siguiente
codigo:

'Inicio Codigo 3
Sub ABRIR3()
Dim Matriz As Variant, oLibro As Workbook, x As Long, y As Long
ArchivoAAbrir = Application.GetOpenFilename _
("Archivos de Microsoft Excel (*.XLS), *.XLS")
If ArchivoAAbrir <> False Then
Set oLibro = Workbooks.Open(ArchivoAAbrir)
With oLibro
With .Worksheets("Hoja1")
Matriz = Unique(.Range(.Range("A3"), _
.Cells(.Rows.Count, "A").End(xlUp)))
End With
.Close
End With
With UserForm1
.ListBox1.List() = Matriz
.Show
End With
End If
End Sub

Function Unique(inArray As Range) As Variant
Dim colItems As Collection
Dim cell As Range
Dim temp As Variant

Set colItems = New Collection
On Error Resume Next
For Each cell In inArray
colItems.Add cell.Value, CStr(cell.Value)
Next cell
ReDim temp(colItems.Count)
For i = 1 To colItems.Count
temp(i) = colItems.Item(i)
Next i
Unique = temp
End Function
'Fin Codigo 3

3) Si aparte de filtrar valores unicos necesitas que esten ordenados alfabeticamente, podrias usar la siguiente funcion de John
Walkenbach:
http://j-walk.com/ss/excel/tips/tip15.htm

4) Si es otra cosa, comentas detalles adicionales?

Saludos,
KL

Preguntas similares