Respuesta : ALGUIEN SABE HACER ESTO MEJOR Y MÁS RESUMIDO. MI OBJETIVO ES APRENDER

#1 Gabriela

18/05/2009 - 20:07 | Informe spam

On May 18, 5:22 am, wrote:

Un saludo. Utilizo excel 2007. Este código hace exactamente lo que yo
quiero, pero seguro que se puede mejorar y me gustaría ver si alguien
pudiera enseñarme. Lo hago paso a paso para no equivocarme.

Gracias

Hola

Algunos buenas practicas para empezar...

- Siempre utiliza la instrucción "Option Explicit" como primera
instrucción en cualquier módulo / hoja con algún procedimiento. Esta
instrucción te obliga a declarar todas las variables que se utilizan
lo cual trae algunas ventajas.

- Siempre agrega comentarios, lo que es claro para ti, no lo es para
las demas personas que vean tu código, y tal vez no será claro para ti
despues de algunos meses.

- No es buena idea nombrar a una variable "jose". Es mejor utilizar
nombres que tengan algun significado y que facilite la lectura de
código.

- Utiliza prefijos en los nombres de las variables, por ejemplo: "Dim
varDatos as Variant" o "Dim intCount as Integer".

- Declara a tus variables en el procedimiento principal, y pasa los
valores como parametros a los otros procedimientos, por ejemplo:

Sub procedimiento()
Dim varDatos As Variant
varDatos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133,
134, 135, 136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)
Call Macro1(varDatos)
.
.
.
End Sub

Sub Macro1(varDatos As Variant)
.
.
End Sub

- No veo ninguna razón práctica para hacer procedimientos con una sola
instrucción, en lugar del "Call" utiliza la instrucción en tu
procedimiento principal
-Haz que tus procedimientos sean "reutilizables", por ejemplo, en
lugar de

Sub borrar_filas_vacias()
Set hoja = Sheets("resumen")
.
.
Set hoja = Nothing
End Sub

Sería de esta manera, eliminando las instrucciones "Set"
Sub borrar_filas_vacias(hoja As Worksheet)
.
.
End Sub

Espero que esto sea de utilidad

Gabriela Cerra

Responder a este mensaje

#2 Anonimo

18/05/2009 - 22:50 | Informe spam

Hola Gabriela, Gracias por tu ayuda

Una cosa que no entiendo. He intentado que datos= array(119,120,121) por
ejemplo pueda utilizarlo en todos los procedimientos de un modulo. Pero no
tengo forma de conseguirlo.

Podrias hacerme todo el codigo como tu lo harias, de esta forma yo aprendo
viendo tus conocimientos. Si es mucho pedir, lo siento, pero me serviria de
gran ayuda.

"Gabriela" escribió en el mensaje de noticias
news:
On May 18, 5:22 am, wrote:

Un saludo. Utilizo excel 2007. Este código hace exactamente lo que yo
quiero, pero seguro que se puede mejorar y me gustaría ver si alguien
pudiera enseñarme. Lo hago paso a paso para no equivocarme.

Gracias

Hola

Algunos buenas practicas para empezar...

- Siempre utiliza la instrucción "Option Explicit" como primera
instrucción en cualquier módulo / hoja con algún procedimiento. Esta
instrucción te obliga a declarar todas las variables que se utilizan
lo cual trae algunas ventajas.

- Siempre agrega comentarios, lo que es claro para ti, no lo es para
las demas personas que vean tu código, y tal vez no será claro para ti
despues de algunos meses.

- No es buena idea nombrar a una variable "jose". Es mejor utilizar
nombres que tengan algun significado y que facilite la lectura de
código.

- Utiliza prefijos en los nombres de las variables, por ejemplo: "Dim
varDatos as Variant" o "Dim intCount as Integer".

- Declara a tus variables en el procedimiento principal, y pasa los
valores como parametros a los otros procedimientos, por ejemplo:

Sub procedimiento()
Dim varDatos As Variant
varDatos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133,
134, 135, 136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)
Call Macro1(varDatos)
.
.
.
End Sub

Sub Macro1(varDatos As Variant)
.
.
End Sub

- No veo ninguna razón práctica para hacer procedimientos con una sola
instrucción, en lugar del "Call" utiliza la instrucción en tu
procedimiento principal
-Haz que tus procedimientos sean "reutilizables", por ejemplo, en
lugar de

Sub borrar_filas_vacias()
Set hoja = Sheets("resumen")
.
.
Set hoja = Nothing
End Sub

Sería de esta manera, eliminando las instrucciones "Set"
Sub borrar_filas_vacias(hoja As Worksheet)
.
.
End Sub

Espero que esto sea de utilidad

Gabriela Cerra

Responder a este mensaje

#3 pepe

19/05/2009 - 16:21 | Informe spam

Option Explicit

Dim hoja As Worksheet
Dim ClaveCampeonato
Dim x
Dim Campeonato
Dim ultfila
Dim fila
Dim nFila
Dim nColumna
Private Sub CargarCampeonato() ' MEJOR TENER SÓLO UNA LISTA DE CLAVES
DE CAMPEONATO, ES MÁS FÁICL DE MANTENER

ClaveCampeonato = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133,
134, 135, 136, _
137, 138, 139, 140, 141, 142, 143, 144, 145, 146,
147, 148, 149)

End Sub

Public Sub Macro1()

CargarCampeonato
nFila = 0
nColumna = 1
For Each Campeonato In ClaveCampeonato
With Sheets("hoja1").QueryTables.Add( _
Connection:="URL;http://www.futbolcracks.com/consult...amp="
& Campeonato & "", _
Destination:=Sheets("hoja1").Cells(nFila * 50 + 1, nColumna))
' MEJOR UTILIZAR NUMEROS DE FILAS Y COLUMNAS
.Name = "equipo" & Campeonato
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
' PARA EVIETAR EL PARPADEO, SI QUIERES AJUSTAR HAZLO AL FINAL
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
nFila = nFila + 1
Next

End Sub

escribió en el mensaje de noticias
news:%

Un saludo. Utilizo excel 2007. Este código hace exactamente lo que yo
quiero, pero seguro que se puede mejorar y me gustaría ver si alguien
pudiera enseñarme. Lo hago paso a paso para no equivocarme.

Gracias

Dim hoja As Worksheet

Public Sub Macro1()
'
' Macro1 Macro
'

'

datos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133, 134, 135,
136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)

x = 1
For Each jose In datos
With Sheets("hoja1").QueryTables.Add(Connection:= _

"URL;http://www.futbolcracks.com/consult...amp=" &
jose & "", _
Destination:=Sheets("hoja1").Range("$A$" & (x * 50) - 49 & ""))
.Name = "equipo" & jose
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

x = x + 1
Next

End Sub

Sub borrar_tablas()

For Each datos In Sheets("hoja1").QueryTables

datos.Delete

Next

End Sub

Sub borrar_filas_sobran()

Sheets("hoja1").Range("d:k").EntireColumn.Delete

End Sub

Sub ajustar_fila_A()

Sheets("hoja1").Range("a:a").ColumnWidth = 5

End Sub

Sub poner_categoria_equipo()

ultfila = Sheets("hoja1").Range("b5000").End(xlUp).Row

datos = Array(119, 122, 125, 126, 127, 128, 129, 130, 131, 133, 134, 135,
136, 137, _
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149)

x = 0
For fila = 3 To ultfila Step 50

Sheets("hoja1").Range("e" & fila) = datos(x)
Sheets("hoja1").Range("d" & fila & ":d" & Range("c" &
fila).End(xlDown).Row).Formula = "=+VLOOKUP($E$" & fila & ",equipos,2)"
Sheets("hoja1").Range("d" & fila & ":d" & Range("c" &
fila).End(xlDown).Row).Copy
Sheets("hoja1").Range("d" & fila).PasteSpecial xlPasteValues

Application.CutCopyMode = False

x = x + 1
Next

End Sub

Sub borrar_fila_sobrante()

Sheets("hoja1").Range("e:e").EntireColumn.Delete

End Sub

Sub copiar_datos_hoja_resumen()

Set hoja = Sheets("resumen")

ultfila = Range("b5000").End(xlUp).Row

For fila = 1 To ultfila Step 50

Sheets("hoja1").Range("a" & fila).CurrentRegion.Copy
hoja.Range("a" & hoja.Range("a10000").End(xlUp).Row + 1).PasteSpecial
xlPasteValues

Next

Set hoja = Nothing

End Sub

Sub borrar_filas_vacias()

Set hoja = Sheets("resumen")

ultfila = hoja.Range("b5000").End(xlUp).Row

For fila = ultfila To 1 Step -1

If IsEmpty(hoja.Range("b" & fila)) = True Then hoja.Range("b" &
fila).EntireRow.Delete
If hoja.Range("b" & fila) = "Equipo" Then hoja.Range("b" &
fila).EntireRow.Delete

Next

Set hoja = Nothing

End Sub

Sub insertar_fila()

Set hoja = Sheets("resumen")

hoja.Rows("1:1").Insert

Set hoja = Nothing

End Sub

Sub insertar_encabezado()

Set hoja = Sheets("resumen")

hoja.Range("a1:d1") = Array("ORDEN", "EQUIPO", "PUNTOS", "CATEGORIA")

hoja.Range("a1").CurrentRegion.Columns.AutoFit

Set hoja = Nothing

End Sub
Sub Hacer_tabla()

Sheets("resumen").Select

Set hoja = Sheets("resumen")

hoja.ListObjects.Add(xlSrcRange, hoja.Range("a1").CurrentRegion, ,
xlYes).Name = _
"Tabla1"
Range("Tabla1[#All]").Select
hoja.ListObjects("Tabla1").TableStyle = "TableStyleLight14"
Range("Tabla1[[#Headers],[ORDEN]]").Select

Set hoja = Nothing

End Sub

Sub Quitar_de_Lista()

Set hoja = Sheets("resumen")

Dim n As Byte
With hoja
For n = 1 To .ListObjects.Count
.ListObjects(1).Unlist
Next
End With

Set hoja = Nothing

End Sub

Sub numerar_equipos()

Set hoja = Sheets("resumen")

hoja.Range("a2") = 1

ultfila = hoja.Range("b5000").End(xlUp).Row

hoja.Range("a3:a" & ultfila).Formula = "=+(1+a2)"

hoja.Range("a2:a" & ultfila).Copy
hoja.Range("a2").PasteSpecial xlPasteValues

hoja.Range("a1").Activate

Set hoja = Nothing

End Sub

Sub procedimiento()

Application.CutCopyMode = False
Application.ScreenUpdating = False

Sheets("hoja1").Range("a1:g10000").Clear
Sheets("resumen").Range("a1").CurrentRegion.Clear

Call Macro1
Call borrar_tablas
Call borrar_filas_sobran
Call ajustar_fila_A
Call poner_categoria_equipo
Call borrar_fila_sobrante
Call copiar_datos_hoja_resumen
Call borrar_filas_vacias
Call insertar_fila
Call insertar_encabezado
Call Hacer_tabla
Call Quitar_de_Lista
Call numerar_equipos

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Responder a este mensaje

#4 Gabriela

19/05/2009 - 21:58 | Informe spam

On May 18, 3:50 pm, wrote:

Hola Gabriela, Gracias por tu ayuda

Una cosa que no entiendo. He intentado que datos= array(119,120,121) por
ejemplo pueda utilizarlo en todos los procedimientos de un modulo. Pero no
tengo forma de conseguirlo.

Podrias hacerme todo el codigo como tu lo harias, de esta forma yo aprendo
viendo tus conocimientos. Si es mucho pedir, lo siento, pero me serviria de
gran ayuda.

Hola

Bueno, no soy experta en BVA pero hago mi luchita, asi que todavia se
puede mejorar. Ademas de las observaciones anteriores:

- No vi la utilidad de bajar los datos en una hoja y despues pegarlos
en otra, asi que todo se hace en la misma hoja de reporte
- Cada tabla de datos baja en donde termina la anterior, en lugar de
bajar los datos cada 50 filas.
- La categoria se agrega al momento de bajar los datos, sin necesidad
de usar fórmula, se utlizan los valores de un array.
- Los valores de las variables se pasan a otro pocedimiento mediante
argumentos. Lo deje asi para que veas como se pasa, pero en realidad
solo los necesitas en el procedimiento donde bajan los datos, ahi
mismo se pueden definir y no en el procedimiento principal.
- No es nada eficiente recorrer celda por celda para ver si se cumple
alguna condición.
- Acostumbro nombrar las variables en ingles, asi mi código queda mas
"Internacional"
- Acostumbro a nombrar las variables utilizando mayusculas y
minusculas, es mas fácil detectar los errores de "dedo" y ver cuando
se escriben mal. Esto solo se puede cuando las variables estan
definidas anteriormente.

Solo quedaron dos procedimientos, el principal y en donde se bajan los
datos. Los dos que faltan son: Hacer_tabla, Quitar_de_Lista, por
problemas con las versiones de Excel, todos los demas procedimientos,
los elimine.

Sub MainProcedure()

' Definir variables
Dim varNo As Variant, varCategory As Variant
Dim wsReport As Worksheet
Dim qt As QueryTable

' Los valores de las variables la toma de rangos definidos en
' el libro, asi se agregan y eliminan elementos facilmente sin
' tener que modificar el código
Set varNo = Range("eqNo")
Set varCategory = Range("eqCategory")
' Es la hoja de libro en la que se bajaran los datos
Set wsReport = Sheets("Resumen")

Application.CutCopyMode = False
Application.ScreenUpdating = False

wsReport.Range("a1").CurrentRegion.Clear

'Las variables pasan como parametros al procedimiento que
'baja los datos
Call DataDownload(varNo, varCategory, wsReport)

For Each qt In wsReport.QueryTables
qt.Delete
Next

' With te ayuda a no tener que teclear lo mismo muchas veces
With wsReport
.Range("d:k").EntireColumn.Delete 'Borra columnas no necesarias
.Range("d:d").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Borra las filas no necesarias
.Rows("1:1").Insert 'Inserta primera fila
.Range("a1:d1") = Array("ORDEN", "EQUIPO", "PUNTOS", "CATEGORIA")
'Pone encabezados
.Range("a1").CurrentRegion.Columns.AutoFit 'Da el ancho a las
columnas
End With

Call Hacer_tabla 'No lo modifique porque trabajo con Excel 2003
Call Quitar_de_Lista

'Usando el AutoFill puedes numerar los equipos
wsReport.Range("A2").AutoFill _
Destination:=Range(wsReport.Range("A2"), wsReport.Range("A2").End
(xlDown)), _
Type:=xlFillSeries

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Public Sub DataDownload(varNo As Variant, varCategory As Variant, ws
As Worksheet)
'
' Baja Datos los equipos y agrega Categoria en la primer columna libre
'
'Definir variables
Dim vNo As Variant
Dim rgDest As Range
Dim iCount As Integer

'Inicializar variables
Set rgDest = ws.Range("A1")
iCount = 1

' Baja datos de la Red
For Each vNo In varNo
With ws.QueryTables.Add(Connection:= _
"URL;http://www.futbolcracks.com/consult...ement.php?
year=6&champ=" & vNo & "", _
Destination:=rgDest)
.Name = "equipo" & vNo
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'Agrega la categoria
ws.Range(rgDest.Offset(2, 11), rgDest.End(xlDown).Offset(0, 11)).Value
= varCategory(iCount)

iCount = iCount + 1

'La nueva celda destino es la siguiente fila de la ultima celda
ocupada
Set rgDest = rgDest.End(xlDown).Offset(1, 0)

Next
End Sub

Responder a este mensaje

#5 Anonimo

20/05/2009 - 01:30 | Informe spam

He estado revisando el codigo, he tenido que adaptarle un poco, pero estoy
aprendiendo bastante cosas de el, y que me serviran para otras aplicaciones,
Gracias.

"Gabriela" escribió en el mensaje de noticias
news:
On May 18, 3:50 pm, wrote:

Hola Gabriela, Gracias por tu ayuda

Una cosa que no entiendo. He intentado que datos= array(119,120,121) por
ejemplo pueda utilizarlo en todos los procedimientos de un modulo. Pero no
tengo forma de conseguirlo.

Podrias hacerme todo el codigo como tu lo harias, de esta forma yo aprendo
viendo tus conocimientos. Si es mucho pedir, lo siento, pero me serviria
de
gran ayuda.

Hola

Bueno, no soy experta en BVA pero hago mi luchita, asi que todavia se
puede mejorar. Ademas de las observaciones anteriores:

- No vi la utilidad de bajar los datos en una hoja y despues pegarlos
en otra, asi que todo se hace en la misma hoja de reporte
- Cada tabla de datos baja en donde termina la anterior, en lugar de
bajar los datos cada 50 filas.
- La categoria se agrega al momento de bajar los datos, sin necesidad
de usar fórmula, se utlizan los valores de un array.
- Los valores de las variables se pasan a otro pocedimiento mediante
argumentos. Lo deje asi para que veas como se pasa, pero en realidad
solo los necesitas en el procedimiento donde bajan los datos, ahi
mismo se pueden definir y no en el procedimiento principal.
- No es nada eficiente recorrer celda por celda para ver si se cumple
alguna condición.
- Acostumbro nombrar las variables en ingles, asi mi código queda mas
"Internacional"
- Acostumbro a nombrar las variables utilizando mayusculas y
minusculas, es mas fácil detectar los errores de "dedo" y ver cuando
se escriben mal. Esto solo se puede cuando las variables estan
definidas anteriormente.

Solo quedaron dos procedimientos, el principal y en donde se bajan los
datos. Los dos que faltan son: Hacer_tabla, Quitar_de_Lista, por
problemas con las versiones de Excel, todos los demas procedimientos,
los elimine.

Sub MainProcedure()

' Definir variables
Dim varNo As Variant, varCategory As Variant
Dim wsReport As Worksheet
Dim qt As QueryTable

' Los valores de las variables la toma de rangos definidos en
' el libro, asi se agregan y eliminan elementos facilmente sin
' tener que modificar el código
Set varNo = Range("eqNo")
Set varCategory = Range("eqCategory")
' Es la hoja de libro en la que se bajaran los datos
Set wsReport = Sheets("Resumen")

Application.CutCopyMode = False
Application.ScreenUpdating = False

wsReport.Range("a1").CurrentRegion.Clear

'Las variables pasan como parametros al procedimiento que
'baja los datos
Call DataDownload(varNo, varCategory, wsReport)

For Each qt In wsReport.QueryTables
qt.Delete
Next

' With te ayuda a no tener que teclear lo mismo muchas veces
With wsReport
.Range("d:k").EntireColumn.Delete 'Borra columnas no necesarias
.Range("d:d").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Borra las filas no necesarias
.Rows("1:1").Insert 'Inserta primera fila
.Range("a1:d1") = Array("ORDEN", "EQUIPO", "PUNTOS", "CATEGORIA")
'Pone encabezados
.Range("a1").CurrentRegion.Columns.AutoFit 'Da el ancho a las
columnas
End With

Call Hacer_tabla 'No lo modifique porque trabajo con Excel 2003
Call Quitar_de_Lista

'Usando el AutoFill puedes numerar los equipos
wsReport.Range("A2").AutoFill _
Destination:=Range(wsReport.Range("A2"), wsReport.Range("A2").End
(xlDown)), _
Type:=xlFillSeries

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Public Sub DataDownload(varNo As Variant, varCategory As Variant, ws
As Worksheet)
'
' Baja Datos los equipos y agrega Categoria en la primer columna libre
'
'Definir variables
Dim vNo As Variant
Dim rgDest As Range
Dim iCount As Integer

'Inicializar variables
Set rgDest = ws.Range("A1")
iCount = 1

' Baja datos de la Red
For Each vNo In varNo
With ws.QueryTables.Add(Connection:= _
"URL;http://www.futbolcracks.com/consult...ement.php?
year=6&champ=" & vNo & "", _
Destination:=rgDest)
.Name = "equipo" & vNo
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'Agrega la categoria
ws.Range(rgDest.Offset(2, 11), rgDest.End(xlDown).Offset(0, 11)).Value
= varCategory(iCount)

iCount = iCount + 1

'La nueva celda destino es la siguiente fila de la ultima celda
ocupada
Set rgDest = rgDest.End(xlDown).Offset(1, 0)

Next
End Sub

Siga el debate Respuesta

Responder a este mensaje

Ads by Google

ALGUIEN SABE HACER ESTO MEJOR Y MÁS RESUMIDO. MI OBJETIVO ES APRENDER

Preguntas similare

Leer las respuestas