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 SubSub 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 SubSub 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 SubTe 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