Como se pueden unificar macros
Necesito de su colaboración para unificar varias macros. Cada macro esta en un modulo.
1 respuesta
Respuesta de Dante Amor
1
1
Dante Amor, https://www.youtube.com/@CursosDeExcelyMacros
H o l a:
De estas macros:
Sub importar() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\REPORTES\desbloqueos Noviembre.txt", _ Destination:=Range("$A$1")) .Name = "desbloqueos Noviembre" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Dim n As Long 'nº filas Dim i As Long Dim Fila As String n = ActiveSheet.UsedRange.Rows.Count For i = n To 1 Step -1 Fila = i & ":" & i If WorksheetFunction.CountA(Range(Fila)) = 0 Then Range("A" & i).EntireRow.Delete End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub
Sub borra1() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Application.CutCopyMode = False Dim Celda As Range Dim palabra As String Dim valida As String Range("A1:A" & Columns("A:A").Range("A1048576").End(xlUp).Row).Select palabra = "0x" palabra = "*" & palabra & "*" valida = "Information" For Each Celda In Selection If Celda.Value Like palabra Then Celda.Select ActiveCell.EntireRow.Select ActiveCell.EntireRow.Delete End If Next Celda Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub
Sub borra2() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Application.CutCopyMode = False Dim Celda As Range Dim palabra As String Dim valida As String Range("A1:A" & Columns("A:A").Range("A1048576").End(xlUp).Row).Select palabra = "The" palabra = "*" & palabra & "*" valida = "Information" For Each Celda In Selection If Celda.Value Like palabra Then Celda.Select ActiveCell.EntireRow.Select ActiveCell.EntireRow.Delete End If Next Celda Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub
Te anexo la macro unificada:
Sub MacroUnica() 'Por.Dante Amor Application.ScreenUpdating = False ' With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\REPORTES\desbloqueos Noviembre.txt", _ Destination:=Range("$A$1")) .Name = "desbloqueos Noviembre" .FieldNames = True: .RowNumbers = False: .FillAdjacentFormulas = False .PreserveFormatting = True: .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells: .SavePassword = False .SaveData = True: .AdjustColumnWidth = True: .RefreshPeriod = 0 .TextFilePromptOnRefresh = False: .TextFilePlatform = 65001 .TextFileStartRow = 1: .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False: .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False: .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False: .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True: .Refresh BackgroundQuery:=False End With ' For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete ElseIf Cells(i, "A") Like "*0x*" Or _ Cells(i, "A") Like "*The*" Or _ Cells(i, "A") Like "*If*" Or _ Cells(i, "A") Like "*S-1*" Then Rows(i).Delete ElseIf Cells(i, "A") <> "sosservicios" And Left(Cells(i, "A"), 3) = "SOS" Then Rows(i).Delete End If Next Application.ScreenUpdating = True MsgBox "Fin" End Sub
- Compartir respuesta
- Anónimo
ahora mismo