Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Why 2 macros differ so much in speed?
I have 2 macros who basically copy values from an .txt
file (FileToOpen) to an existing Excel spreadsheet. Why does Macro 1 take a long 30 seconds to run and Macro 2 only 2 second, if the filesize is nearly equal? TIA Martin Macro 1: Sub Importar_vdn() Dim Fecha_actual As Date Dim Fecha_import As Date Dim lngsourceLr As Long Dim lngdestLr As Long Dim lngdestRange As Long Dim rwIndex As Long Dim wkb As Workbook Dim wks As Worksheet Dim DateDiff1 As Long Dim SourceRange As Range Dim DestRange As Range Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Set wkb = Workbooks("Workbook1.XLS") Set wks = wkb.Worksheets("Datos VDN") wks.Activate lngdestLr = LastRow2(ActiveSheet) ' Sheets("Datos VDN").Select Range("D" & lngdestLr).Select Fecha_actual = CDate(ActiveCell.Value) FileToOpen = Application.GetOpenFilename ("Textfiles (*.txt),*.txt") If FileToOpen < False Then 'Aquí necesita un procedimiento que me permite abrir cualquier fichero (independentemente del nº de líneas!) ' Open textfile FileToOpen (tiene 34 columnas: desde columna A hasta columna AH) Workbooks.OpenText Filename:=FileToOpen, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ Array(7, 1), Array(8, 1), Array(9, 1), Array (10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _ ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _ (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _ Array(27, 1), Array(28, 1), Array(29, 1), Array (30, 1), Array(31, 1), Array(32, 1), Array( _ 33, 1), Array(34, 1)) ' Array(2,2) indica que columna hay que importarla como texto Else: Exit Sub End If Fecha_import = CDate(Range("B1").Value) DateDiff1 = DateDiff("d", Fecha_actual, Fecha_import) If DateDiff1 = 1 Or DateDiff1 = 0 Then lngsourceLr = LastRow2(ActiveSheet) lngdestRange = lngdestLr + lngsourceLr - 2 wks.Activate ActiveCell.Offset(1, 1).Range("A1").Activate ActiveWindow.ActivateNext Set SourceRange = ActiveSheet.Range("B3:AH" & lngsourceLr) ActiveWindow.ActivateNext Set DestRange = wks.Range("E" & lngdestLr + 1 & ":AK" & lngdestRange) SourceRange.copy DestRange Application.CutCopyMode = False For rwIndex = lngdestLr + 1 To lngdestRange wks.Cells(rwIndex, 1).Formula = "=D" & rwIndex & "&E" & rwIndex wks.Cells(rwIndex, 2).Formula = "=C" & rwIndex & "&E" & rwIndex wks.Cells(rwIndex, 3).Formula = "=TEXT(D" & rwIndex & ",""m"")" wks.Cells(rwIndex, 4).Value = Fecha_import Next rwIndex ActiveWindow.ActivateNext ActiveWindow.Close False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Else: MsgBox "Fecha incorrecta" End If End Sub Function LastRow2(sh As Worksheet) On Error Resume Next LastRow2 = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Importar_splitskill() Dim Fecha_actual As Date Dim Fecha_import As Date Dim lngsourceLr As Long Dim lngdestLr As Long Dim lngdestRange As Long Dim rwIndex As Long Dim wkb As Workbook Dim wks As Worksheet Dim DateDiff1 As Long Dim SourceRange As Range Dim DestRange As Range Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Set wkb = Workbooks("Workbook1.XLS") Set wks = wkb.Worksheets("Datos Skill") wks.Activate lngdestLr = LastRow2(ActiveSheet) ' Sheets("Datos VDN").Select Range("D" & lngdestLr).Select Fecha_actual = CDate(ActiveCell.Value) FileToOpen = Application.GetOpenFilename ("Textfiles (*.txt),*.txt") If FileToOpen < False Then Workbooks.OpenText Filename:=FileToOpen, Origin _ :=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _ , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _ Array(22, 1), Array(23, 1), Array(24, 1), Array (25, 1), Array(26, 1), Array(27, 1), Array( _ 28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _ Array(35, 1), Array(36, 1), Array(37, 1)), TrailingMinusNumbers:=True Else: Exit Sub End If Fecha_import = CDate(Range("A3").Value) DateDiff1 = DateDiff("d", Fecha_actual, Fecha_import) If DateDiff1 = 1 Or DateDiff1 = 0 Then 'Copiar datos lngsourceLr = LastRow2(ActiveSheet) lngdestRange = lngdestLr + lngsourceLr - 2 Columns("C:C").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight If InStr(1, FileToOpen, "cce") < 0 Then Range("C3:C" & lngsourceLr).Value = "cce" ElseIf InStr(1, FileToOpen, "tuerca") < 0 Then Range("C3:C" & lngsourceLr).Value = "tuerca" Else: MsgBox "Error" Exit Sub End If wks.Activate ActiveCell.Offset(1, 3).Range("A1").Activate ActiveWindow.ActivateNext Set SourceRange = ActiveSheet.Range("B3:AL" & lngsourceLr) ActiveWindow.ActivateNext Set DestRange = wks.Range("G" & lngdestLr + 1 & ":AQ" & lngdestRange) SourceRange.copy DestRange Application.CutCopyMode = False ' Copiar formulas For rwIndex = lngdestLr + 1 To lngdestRange wks.Cells(rwIndex, 1).Formula = "=D" & rwIndex & "&G" & rwIndex wks.Cells(rwIndex, 2).Formula = "=C" & rwIndex & "&G" & rwIndex wks.Cells(rwIndex, 3).Formula = "=TEXT(D" & rwIndex & ",""m"")" wks.Cells(rwIndex, 4).Value = Fecha_import wks.Cells(rwIndex, 5).Formula = "=I" & rwIndex & "*L" & rwIndex wks.Cells(rwIndex, 6).Formula = "=M" & rwIndex & "*L" & rwIndex Next rwIndex ActiveWindow.ActivateNext ActiveWindow.Close False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Else: MsgBox "Fecha incorrecta" End If End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
data validation fonts differ in drop down box | Excel Worksheet Functions | |||
how to select no.'s in a column that differ by <1 | Excel Discussion (Misc queries) | |||
Can the contents of a drop down box differ from what's entered? | Excel Worksheet Functions | |||
Can you speed UP drag speed? | Excel Discussion (Misc queries) | |||
powerpoint & excel how do they differ? | New Users to Excel |