Saltar al contenido

Ejecutar macro en archivos de una carpeta


lolae

Recommended Posts

publicado

A ver si alguien me puede ayudar¡¡ De entrada gracias a todos y perdón por mi ignorancia... soy bastante nueva en estos temas... Después de mucho buscar no sé cómo solucionar el siguiente problema...

He creado una macro... y he conseguido que funcione¡¡¡ es la siguiente

Sub test()

Dim i As Long, j As Long, rw As Long

Dim rng As Range, cel As Range

Dim arrWords

Dim xlCalc As XlCalculation

arrWords = Array("number", "media", "genotype", "user", "experiment", "box", "age", "scale", "root") ' edit the array as required

xlCalc = Application.Calculation

Set rng = Range("c1:c2000")

For rw = rng.Rows(rng.Rows.Count).Row To rng.Rows(1).Row Step -1

For j = 0 To UBound(arrWords)

If InStr(1, rng(rw, 1), arrWords(j), vbTextCompare) Then

bDel = True

rng.Parent.Rows(rw).EntireRow.Delete

Exit For

End If

Next

Next

Application.Calculation = xlCalc

arrWords = Array("vector", "angle") ' edit the array as required

xlCalc = Application.Calculation

Set rng = Range("e1:e2000")

For rw = rng.Rows(rng.Rows.Count).Row To rng.Rows(1).Row Step -1

For j = 0 To UBound(arrWords)

If InStr(1, rng(rw, 1), arrWords(j), vbTextCompare) Then

bDel = True

rng.Parent.Rows(rw).EntireRow.Delete

Exit For

End If

Next

Next

Application.Calculation = xlCalc

Columns("D:D").Select

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireRow.Delete

Columns("A:A").Select

Selection.Delete Shift:=xlToLeft

Columns("B:B").Select

Selection.Delete Shift:=xlToLeft

Columns("E:N").Select

Selection.Delete Shift:=xlToLeft

End Sub

Pero ahora no me parece suficiente.. quiero algo más¡¡¡ Me gustaría que esta macro se ejecutara en todos los archivos de una carpeta... pero me gustaría que me preguntara que archivos o que carpeta al menos...

Así que lo intenté de la siguiente manera:

Option Explicit

Sub OpenMultipleUserSelectedFiles()

Dim FileArray As Variant

Dim myBook As Workbook

Dim i As Integer

FileArray = Application.GetOpenFilename(, , "Select the Files", MultiSelect:=True)

If IsArray(FileArray) Then

For i = LBound(FileArray) To UBound(FileArray)

Set myBook = Workbooks.Open(FileArray(i))

Dim i As Long, j As Long, rw As Long

Dim rng As Range, cel As Range

Dim arrWords

Dim xlCalc As XlCalculation

arrWords = Array("number", "media", "genotype", "user", "experiment", "box", "age", "scale", "root") ' edit the array as required

xlCalc = Application.Calculation

Set rng = Range("c1:c2000")

For rw = rng.Rows(rng.Rows.Count).Row To rng.Rows(1).Row Step -1

For j = 0 To UBound(arrWords)

If InStr(1, rng(rw, 1), arrWords(j), vbTextCompare) Then

bDel = True

rng.Parent.Rows(rw).EntireRow.Delete

Exit For

End If

Next

Next

Application.Calculation = xlCalc

arrWords = Array("vector", "angle") ' edit the array as required

xlCalc = Application.Calculation

Set rng = Range("e1:e2000")

For rw = rng.Rows(rng.Rows.Count).Row To rng.Rows(1).Row Step -1

For j = 0 To UBound(arrWords)

If InStr(1, rng(rw, 1), arrWords(j), vbTextCompare) Then

bDel = True

rng.Parent.Rows(rw).EntireRow.Delete

Exit For

End If

Next

Next

Application.Calculation = xlCalc

Columns("D:D").Select

Selection.SpecialCells(xlCellTypeBlanks).Select

Selection.EntireRow.Delete

Columns("A:A").Select

Selection.Delete Shift:=xlToLeft

Columns("B:B").Select

Selection.Delete Shift:=xlToLeft

Columns("E:N").Select

Selection.Delete Shift:=xlToLeft

myBook.Save

myBook.Close

Next i

Else:

MsgBox "You clicked cancel"

End If

End Sub

Pero esta macro sólo funciona si elimino la parte en azul... dice que hay un error al definir i... lo sé... pero no sé cómo arreglarlo¡¡¡

Seguro que hay alguien por ahí que podría explicarmelo

Muchas gracias

publicado

Como mínimo, el problema puede venir por intentar definir la misma variable con diferente "naturaleza"......"i" aparece en la primera línea adjunta como "Integer" y 5 filas después como "Long", lo que obviamente debe confundir al sistema.


[B]Dim i As Integer[/B]
[B] FileArray = Application.GetOpenFilename(, , "Select the Files", MultiSelect:=True)[/B]
[B] If IsArray(FileArray) Then[/B]
[B] For i = LBound(FileArray) To UBound(FileArray)[/B]
[B] Set myBook = Workbooks.Open(FileArray(i))[/B]
[B] [COLOR=#0000ff]Dim i As Long[/COLOR][/B]
[/CODE]

De todos modos, lee las normas del foro.........porque has incumplido algunas de ellas........

Chao,

Tese

publicado

Gracias por la respuesta...el problema está al definir i... pero no sé como arreglarlo... perdón por mi ignorancia en el tema...

ah¡¡ y perdón por incumplir las normas... supongo que con las prisas... perdón de todas formas

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.