abrir varios libros excel

hola, Alberto !

Mostrar la cita

... con una Macro... abrir todos los libros que estan en una carpeta llamada "Lista"
... los datos estan... en cada libro... Ej.
LIBRO 1: A2="AZUCAR",A3="HARINA", A4= "SAL", A5="PAN",A6="AGUA"
LIBRO 2: A2="AZUCAR", A3="AGUA"
LIBRO 3: A2="SAL"
... los articulos que estan en todos los libros... en una lista sin repetirlos...

-> el siguiente ejemplo 'supone' que [todos] los libros contienen los articulos en el rango A2:An de la hoja (1)
-> 'abre' cada libro en la ruta especificada... 'toma' los datos... y cierra cada libro
-> al finalizar... 'devuelve' un listado con los elementos 'unicos' que se encontraron de todos los libros abiertos ;)

si cualquier duda [o en alguna parte mis supuestos estan equivocados]... comentas?
saludos,
hector.

[importante] -> deberas establecer una referencia a la biblioteca de objetos 'microsoft scripting runtime'
en el proyecto de macros-vba [menu] herramientas / referencias... -> la encuentras por orden alfbetico
== copia las liguientes lineas en un modulo de codigo 'normal' ==Sub ListarArticulosUnicos()
Application.ScreenUpdating = False
Dim BuscarDonde As String, Sig As Integer, Celda As Range, Articulo
Dim Articulos As New Scripting.Dictionary
' en la siguiente linea ESPECIFICA el directorio donde quieres 'buscarlos' '
BuscarDonde = "c:uta y\sub-carpeta donde estan\los archivos\" ' NO olvides al final el ->\<- '
With Application.FileSearch
.NewSearch
.LookIn = BuscarDonde
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Sig = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(Sig)
Worksheets(1).Activate
For Each Celda In Range(Range("a2"), Range("a65536").End(xlUp))
Articulo = Application.Trim(UCase(Celda))
If Not Articulos.Exists(Articulo) Then Articulos.Add Articulo, Articulo
Next
ActiveWorkbook.Close False
Next
Sig = 1
For Each Articulo In Articulos.Items
Sig = Sig + 1
Range("b" & Sig) = Articulo
Next
Else: MsgBox "No existen documentos en " & BuscarDonde
End If
End With
End Sub

Gracias Hector la solucion fue estupenda...
ahora la complicamos un poco mas...
Digamos que los articulos estan relacionados con una cantidad Ej:
LIBRO 1: A2="AZUCAR",B2="2",A3="HARINA",B3="1", A4= "SAL",B4="3"
A5="PAN",B5="2",A6="AGUA",B6="1"
LIBRO 2: A2="AZUCAR",B2="1" A3="AGUA",B3="2"
LIBRO 3: A2="SAL",B2="1",A3="PAN", B3= "2"
A4="SAL" , B4="1"
se requiere que LISTE LOS ARTICULOS UNICOS Y ADEMAS QUE INDIQUE LA CANTIDAD
ACUMULADAD DE CADA ARTICULO
Alberto Gonzalez


"Héctor Miguel" escribió:

Mostrar la cita

hola, Alberto !

> ... con una Macro... abrir todos los libros que estan en una carpeta llamada "Lista"
> ... los datos estan... en cada libro... Ej.
> LIBRO 1: A2="AZUCAR",A3="HARINA", A4= "SAL", A5="PAN",A6="AGUA"
> LIBRO 2: A2="AZUCAR", A3="AGUA"
> LIBRO 3: A2="SAL"
> ... los articulos que estan en todos los libros... en una lista sin repetirlos...

-> el siguiente ejemplo 'supone' que [todos] los libros contienen los articulos en el rango A2:An de la hoja (1)
-> 'abre' cada libro en la ruta especificada... 'toma' los datos... y cierra cada libro
-> al finalizar... 'devuelve' un listado con los elementos 'unicos' que se encontraron de todos los libros abiertos ;)

si cualquier duda [o en alguna parte mis supuestos estan equivocados]... comentas?
saludos,
hector.

[importante] -> deberas establecer una referencia a la biblioteca de objetos 'microsoft scripting runtime'
en el proyecto de macros-vba [menu] herramientas / referencias... -> la encuentras por orden alfbetico
== copia las liguientes lineas en un modulo de codigo 'normal' ==> Sub ListarArticulosUnicos()
Application.ScreenUpdating = False
Dim BuscarDonde As String, Sig As Integer, Celda As Range, Articulo
Dim Articulos As New Scripting.Dictionary
' en la siguiente linea ESPECIFICA el directorio donde quieres 'buscarlos' '
BuscarDonde = "c:uta y\sub-carpeta donde estan\los archivos\" ' NO olvides al final el ->\<- '
With Application.FileSearch
.NewSearch
.LookIn = BuscarDonde
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Sig = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(Sig)
Worksheets(1).Activate
For Each Celda In Range(Range("a2"), Range("a65536").End(xlUp))
Articulo = Application.Trim(UCase(Celda))
If Not Articulos.Exists(Articulo) Then Articulos.Add Articulo, Articulo
Next
ActiveWorkbook.Close False
Next
Sig = 1
For Each Articulo In Articulos.Items
Sig = Sig + 1
Range("b" & Sig) = Articulo
Next
Else: MsgBox "No existen documentos en " & BuscarDonde
End If
End With
End Sub

hola, Alberto !

Mostrar la cita

ahora la complicamos un poco mas... los articulos estan relacionados con una cantidad Ej:
LIBRO 1: A2="AZUCAR",B2="2",A3="HARINA",B3="1", A4= "SAL",B4="3" A5="PAN",B5="2",A6="AGUA",B6="1"
LIBRO 2: A2="AZUCAR",B2="1" A3="AGUA",B3="2"
LIBRO 3: A2="SAL",B2="1",A3="PAN", B3= "2" A4="SAL" , B4="1"
... que LISTE LOS ARTICULOS UNICOS Y ADEMAS QUE INDIQUE LA CANTIDAD ACUMULADAD DE CADA ARTICULO

esta bien... esta bien... esta bien... pero 'no te enojes'
[el abuso con el uso de las mayusculas en mensajes y correos electronicos 'equivale' a... GRITAR !!!] :))

con 'ligeras' modificaciones ANTES de cerrar cada libro abierto... el siguiente codigo 'acumula' las cantidades de cada articulo
si cualquier duda [o informacion adicional]... comentas?
saludos,
hector.
=Sub ListarArticulosUnicos()
Application.ScreenUpdating = False
Dim BuscarDonde As String, Sig As Integer, Celda As Range, Articulo
Dim RangoBuscar As String, Unico As Range, Fila As Integer
Dim Articulos As New Scripting.Dictionary
' en la siguiente linea ESPECIFICA el directorio donde quieres 'buscarlos' '
BuscarDonde = "c:uta y\sub-carpeta donde estan\los archivos\" ' NO olvides al final el ->\<- '
With Application.FileSearch
.NewSearch
.LookIn = BuscarDonde
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Sig = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(Sig)
Worksheets(1).Activate
RangoBuscar = Range(Range("a2"), Range("a65536").End(xlUp)).Address
For Each Celda In Range(RangoBuscar)
Articulo = Application.Trim(UCase(Celda))
If Not Articulos.Exists(Articulo) Then Articulos.Add Articulo, Articulo
Next
With ThisWorkbook.Worksheets(1)
Fila = 1
For Each Articulo In Articulos.Items
Fila = Fila + 1
.Range("b" & Fila) = Articulo
Next
For Each Unico In .Range(.Range("b2"), .Range("b65536").End(xlUp))
Unico.Offset(, 1) = Unico.Offset(, 1) + _
Application.SumIf(Range(RangoBuscar), Unico, Range(RangoBuscar).Offset(, 1))
Next
End With
ActiveWorkbook.Close False
Next
Else: MsgBox "No existen documentos en " & BuscarDonde
End If
End With
End Sub

GRACIAS... Hector...

Me disculpas las "Mayusculas" pero no fue mi intencion... solo queria
subrrayar la idea... yo no tengo mucha experiencia en esto de los sintaxis de
los correos y chat... pero estare my al pendiente de no cometer estos
errores
Bien Te comento que la Solucion esta Perfecta!!!!... y Te felicito por tu
Tecnica para resolver problemas, con capacidad asombrosa de resumen es
increiblepracticamente los resuelves en dos lineas

Gracias por tu atencion a mi requerimiento y Espero con este aprendizaje
poder compartirlo con toda la comunidad de estos Chat... :-)
Saludos...
Alberto G
Alberto Gonzalez


"Héctor Miguel" escribió:

Mostrar la cita

hola, Alberto !

> ahora la complicamos un poco mas... los articulos estan relacionados con una cantidad Ej:
> LIBRO 1: A2="AZUCAR",B2="2",A3="HARINA",B3="1", A4= "SAL",B4="3" A5="PAN",B5="2",A6="AGUA",B6="1"
> LIBRO 2: A2="AZUCAR",B2="1" A3="AGUA",B3="2"
> LIBRO 3: A2="SAL",B2="1",A3="PAN", B3= "2" A4="SAL" , B4="1"
> ... que LISTE LOS ARTICULOS UNICOS Y ADEMAS QUE INDIQUE LA CANTIDAD ACUMULADAD DE CADA ARTICULO

esta bien... esta bien... esta bien... pero 'no te enojes'
[el abuso con el uso de las mayusculas en mensajes y correos electronicos 'equivale' a... GRITAR !!!] :))

con 'ligeras' modificaciones ANTES de cerrar cada libro abierto... el siguiente codigo 'acumula' las cantidades de cada articulo
si cualquier duda [o informacion adicional]... comentas?
saludos,
hector.
=> Sub ListarArticulosUnicos()
Application.ScreenUpdating = False
Dim BuscarDonde As String, Sig As Integer, Celda As Range, Articulo
Dim RangoBuscar As String, Unico As Range, Fila As Integer
Dim Articulos As New Scripting.Dictionary
' en la siguiente linea ESPECIFICA el directorio donde quieres 'buscarlos' '
BuscarDonde = "c:uta y\sub-carpeta donde estan\los archivos\" ' NO olvides al final el ->\<- '
With Application.FileSearch
.NewSearch
.LookIn = BuscarDonde
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Sig = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(Sig)
Worksheets(1).Activate
RangoBuscar = Range(Range("a2"), Range("a65536").End(xlUp)).Address
For Each Celda In Range(RangoBuscar)
Articulo = Application.Trim(UCase(Celda))
If Not Articulos.Exists(Articulo) Then Articulos.Add Articulo, Articulo
Next
With ThisWorkbook.Worksheets(1)
Fila = 1
For Each Articulo In Articulos.Items
Fila = Fila + 1
.Range("b" & Fila) = Articulo
Next
For Each Unico In .Range(.Range("b2"), .Range("b65536").End(xlUp))
Unico.Offset(, 1) = Unico.Offset(, 1) + _
Application.SumIf(Range(RangoBuscar), Unico, Range(RangoBuscar).Offset(, 1))
Next
End With
ActiveWorkbook.Close False
Next
Else: MsgBox "No existen documentos en " & BuscarDonde
End If
End With
End Sub