Se traba mi macro
Hola!
Me podrías ayudar por favor... Realice una macro que baja los datos de yahoo finance pero se me pone la pantalla en gris y si realiza el proceso pero muy lentamente.
Ya tenia la macro antes y funcionaba muy bien, pero después de realizar unos pequeños cambios paso lo descrito.
Aquí te dejo el código:
Sub GetData()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Clear
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet
uf = Range("A65536").End(xlUp).Row
tasa_libre = Cells(7, 5).Value
For i = 6 To uf
If Cells(i, 1) <> "" Then
siglas = Cells(i, 1).Value
nombre = Cells(i, 2).Value
qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Cells(i, 1).Value & ".MX" & "&d=" & Cells(5, 7).Value & "&e=" & Cells(6, 7).Value & "&f=" & Cells(7, 7).Value & "&g=d&a=" & Cells(2, 7).Value & "&b=" & Cells(3, 7).Value & "&c=" & Cells(4, 7).Value & "&ignore=.csv"
Cells(i, 3).Value = IIf(HttpExists(qurl), "Valid", "Not Valid")
Columns("M:M").Select
Selection.ClearContents
If Cells(i, 3).Value = "Valid" Then
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("M1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
uf_datosbajados = Range("M65536").End(xlUp).Row
Range("M1:M" & uf_datosbajados).Select
Selection.Cut
Sheets("Base de datos").Activate
uf_datos = Range("B65536").End(xlUp).Row + 1
Cells(uf_datos, 1).Select
ActiveSheet.Paste
Selection.TextToColumns Destination:=Range("A" & uf_datos), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 5), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
If i = 6 Then
Rows(uf_datos - 1 & ":" & uf_datos - 1).Select
Selection.Delete Shift:=xlUp
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Cells(1, 8).Value = "Siglas"
Cells(1, 9).Value = "Nombre"
Else
Rows(uf_datos & ":" & uf_datos).Select
Selection.Delete Shift:=xlUp
End If
uf_datos2 = Range("B65536").End(xlUp).Row
Range("H" & uf_datos & ":H" & uf_datos2).Select
Selection.FormulaR1C1 = siglas
Range("I" & uf_datos & ":I" & uf_datos2).Select
Selection.FormulaR1C1 = nombre
Sheets("Datos a bajar").Activate
Cells(1, 1).Select
End If
End If
Next i
''''''''''''''''''bajar IPC
siglas = Cells(10, 5).Value
nombre = Cells(10, 4).Value
qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Cells(10, 5).Value & "&d=" & Cells(5, 7).Value & "&e=" & Cells(6, 7).Value & "&f=" & Cells(7, 7).Value & "&g=d&a=" & Cells(2, 7).Value & "&b=" & Cells(3, 7).Value & "&c=" & Cells(4, 7).Value & "&ignore=.csv"
Cells(11, 5).Value = IIf(HttpExists(qurl), "Valid", "Not Valid")
Columns("M:M").Select
Selection.ClearContents
If Cells(11, 5).Value = "Valid" Then
QueryQuote2:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("M1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
uf_datosbajados = Range("M65536").End(xlUp).Row
Range("M1:M" & uf_datosbajados).Select
Selection.Cut
Sheets("IPC").Activate
uf_datos = Range("B65536").End(xlUp).Row + 1
Cells(uf_datos, 1).Select
ActiveSheet.Paste
Selection.TextToColumns Destination:=Range("A" & uf_datos), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 5), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Rows(uf_datos - 1 & ":" & uf_datos - 1).Select
Selection.Delete Shift:=xlUp
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Cells(1, 8).Value = "Siglas"
Cells(1, 9).Value = "Nombre"
uf_datos2 = Range("B65536").End(xlUp).Row
Range("H" & uf_datos & ":H" & uf_datos2).Select
Selection.FormulaR1C1 = siglas
Range("I" & uf_datos & ":I" & uf_datos2).Select
Selection.FormulaR1C1 = nombre
uf_ipc = Range("A65536").End(xlUp).Row
End If
''''''''''se bajo IPC
Sheets("Base de datos").Activate
Cells(1, 1).Select
'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
uf_datosbajados = Range("A1000000").End(xlUp).Row
Cells(1, 10).Value = "IPC"
Range(Cells(2, 10), Cells(uf_datosbajados, 10)).Select
Selection.FormulaR1C1 = "=VLOOKUP(RC[-9],IPC!R2C1:R" & uf_ipc & "C7,7,FALSE)"
'Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Application.CutCopyMode = False
Range(Cells(1, 1), Cells(uf_datosbajados, 10)).Select
Selection.AutoFilter
ActiveSheet.Range(Cells(1, 10), Cells(uf_datosbajados, 10)).AutoFilter Field:=10, Criteria1:="#N/A"
Rows("2:" & uf_datosbajados).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Cells(1, 11).Value = "Rendimiento"
Range(Cells(2, 11), Cells(uf_datosbajados, 11)).Select
Selection.FormulaR1C1 = "=IF(RC[-3]=R[1]C[-3],LN(RC[-4]/R[1]C[-4]),"""")"
'Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Application.CutCopyMode = False
Cells(1, 12).Value = "Premio al riesgo"
Range(Cells(2, 12), Cells(uf_datosbajados, 12)).Select
Selection.FormulaR1C1 = "=RC[-1]-" & tasa_libre
Cells(1, 13).Value = "Rendimiento IPC"
Range(Cells(2, 13), Cells(uf_datosbajados, 13)).Select
Selection.FormulaR1C1 = "=IFERROR(LN(RC[-3]/R[1]C[-3]),"""")"
Cells(1, 14).Value = "Alfa 5"
Range(Cells(2, 14), Cells(uf_datosbajados,...