Ver Mensaje Individual
  #14 (permalink)  
Antiguo 16/06/2008, 21:15
choda125
 
Fecha de Ingreso: junio-2008
Mensajes: 7
Antigüedad: 15 años, 10 meses
Puntos: 0
Respuesta: Función o macro para encontrar y copiar

Hola David,
Todavia estas por aca??
Bueno te cuento que esta andando pero me parece que es un desastre y tarda muchisimo.
Me gustaria si pudieras revisar como funciona para que me puedas corregir, ya que seguramente no empleo el mejor camino para llegar a lo que necesito.
Formulario:
Código:
Private Sub CommandButton1_Click()
Extencion = ".CSV"
Dim i As Integer
For i = 1 To 400
ExportData "C:\Documents and Settings\Choda\Escritorio\Nueva\Datos.xls", "C:\Documents and Settings\Choda\Escritorio\Nueva\G4\mydata" & i
TraspasoDatos
Next
End Sub
Modulo1 aca esta tu funcion :
Código:
Function ExportData(ByVal FileName As String, ByVal DataFile As String, Optional ByVal Count As Integer = 2) As Integer
Dim NewXLS As Excel.Application
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Set NewXLS = New Excel.Application
Set NewBook = NewXLS.Workbooks.Open(FileName)
Set NewSheet = NewBook.Worksheets(1)
'Agregamos los encabezados
NewSheet.Range("A1") = "Propietario"
NewSheet.Range("B1") = "Puntos"
NewSheet.Range("C1") = "Alianza"
NewSheet.Range("D1") = "Coordenadas"
NewSheet.Range("E1") = "Situación"
Dim dataXLS As Workbook
Set dataXLS = NewXLS.Workbooks.Open(DataFile)
Dim dataSheet As Worksheet
Set dataSheet = dataXLS.Worksheets(1)
Dim Looping As Byte
'Recorremos desde la primera fila hasta la fila 150
For Looping = 1 To 150
If dataSheet.Range("A" & Looping) = "Propietario" Then
'Extraemos propietario
NewSheet.Range("A" & Count) = dataSheet.Range("B" & Looping)
'Extraemos Puntos
NewSheet.Range("B" & Count) = dataSheet.Range("B" & (Looping + 1))
'Extraemos Alianza
NewSheet.Range("C" & Count) = dataSheet.Range("B" & (Looping + 4))
'Extraemos Coordenadas
NewSheet.Range("I" & Count) = dataSheet.Range("A" & (Looping - 1))
'Extraemos Situación
NewSheet.Range("E" & Count) = dataSheet.Range("B" & (Looping + 5))
'Saltamos los datos extraídos
Looping = Looping + 6
Count = Count + 1
End If
Next Looping
dataXLS.Close False
NewBook.Close True
NewXLS.Quit
Set dataXLS = Nothing
Set NewBook = Nothing
Set NewXLS = Nothing
ExportData = Count
End Function
Modulo2:
Código:
Function TraspasoDatos()
Workbooks.Open FileName:= _
"C:\Documents and Settings\Choda\Escritorio\Nueva\Datos.xls"
Windows("Datos.xls").Activate
Range("A2:E18").Select
Selection.Copy
Windows("David.xls").Activate
Sheets("Hoja1").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Windows("Datos.xls").Activate
Range("A2:C18").ClearContents
Range("E2:E18").ClearContents
Range("I2:I18").ClearContents
ActiveWindow.Close SaveChanges:=True
End Function
Asique tengo un boton que solo puedo ejecutarlo en el archivo David.xls ejecuta las 2 funciones, la primera guarda temporalmente los datos que tiene mydataXXX.csv en Datos.xls y la 2da funcion abre el archivo Datos.xls y copia los datos en el archivo David.xls y cierra Datos.xls para que la 1re funcion pueda abrir el proximo mydataXXX.csv
Son 400 mydata osea mydata1.csv, mydata2.csv ...... mydata400.csv
Te dejo un rar con una mustra de los archivos como para que puedas ver mejor lo que estoy tratando de hacer. Y tambien sobre el archivo con los datos organizados necesito hacer un formulario de busqueda (pense que esa era la parte facil jaja pero tampoco)
http://choda125.bizhat.com/muestra.rar

Muchas gracias y saludos
Andres