Combinar los distintos macros similares de un excel
Yo realizo un reporte en excel el cual me permite seleccionar un note pad y si es terminacion A o B (123456789123-A o 123456789123-B) me importa los datos a distintas celdas, pero yo ocupo importar los archivos, 123456789123-A,
123456789123-B, 123456789123-C, 123456789123-D, 123456789123-E,
123456789123-F, 123456789123-G, 123456789123-H, entonses lo estoy haciendo por 4 codigos con una decision IF A o B, C o D, E o F, G o H, y busco la forma de hacer un solo codigo y activar mediante un boton e independiente del archivo que elija se mande a las celdas correspondientes, separe el codigo en 4 modulos, anexo excel y 8 notepads, para verificar funcionamiento.
Gracias :D
1 respuesta
H o l a:
Te anexo la macro unificada:
Sub LeerNotePad()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = l1.Path & "\"
ChDir ruta
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo NotePad"
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "Archivos Txt", "*.txt*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show Then
letra = Mid(.SelectedItems.Item(1), Len(.SelectedItems.Item(1)) - 4, 1)
Select Case letra
Case "A"
col = Columns("C").Column
num = 9
Case "B"
col = Columns("H").Column
num = 9
Case "C"
col = Columns("C").Column
num = 24
Case "D"
col = Columns("H").Column
num = 24
Case "E"
col = Columns("C").Column
num = 39
Case "F"
col = Columns("H").Column
num = 39
Case "G"
col = Columns("C").Column
num = 54
Case "H"
col = Columns("H").Column
num = 54
Case Else
MsgBox "El archivo no tiene la nomenclatura", vbCritical, "ERROR DE ARCHIVO"
Exit Sub
End Select
'
Set l2 = Workbooks.Open(.SelectedItems.Item(1))
Set h2 = l2.Sheets(1)
Set r = h2.Columns("A")
Set b = r.Find("Ch.", lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
dato1 = Split(h2.Cells(b.Row + 1, "A"), ",")
dato2 = Split(h2.Cells(b.Row + 2, "A"), ",")
h1.Cells(num, col + 1) = dato1(1)
h1.Cells(num, col + 2) = dato1(3)
h1.Cells(num, col + 3) = dato2(1)
h1.Cells(num, col + 4) = dato2(3)
num = num + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
l2.Close
End If
End With
MsgBox "Proceso terminado", vbInformation, "LEER ARCHIVOS"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Muchas gracias me han sido muy útiles tus respuestas, en caso de que mis archivos tuvieran la serie 123456789123-A-A lo que me reconocería seria A-A como realizaría el cambio para que me reconociera las 2 letras y el guion
If .Show Then
letra = Mid(.SelectedItems.Item(1), Len(.SelectedItems.Item(1)) - 4, 1) Select Case letra
Para reconocer 2 letras sería así:
letra = Mid(. SelectedItems. Item(1), Len(. SelectedItems.Item(1)) - 4, 3) Select Case letra
Pero eso ya cambia la estructura del Case.
Lo que debes hacer es decirme todas las posibles combinaciones que puedes tener en letras y entonces creo la estructura del Case para esas combinaciones.
Para el caso de que sea una letra.
Para el caso de que sean 3 letras (A-A)
Me tienes que decir en qué columna y en qué fila empieza.
Valora esta respuesta y en la nueva pregunta me pones el detalle de las combinaciones.
