MACRO QUE ARCHIVA DATOS DE UNA HOJA A OTRA, CON COINCIDENTES SOBREESCRIBE.

Inicio VBA MACRO QUE ARCHIVA DATOS DE UNA HOJA A OTRA, CON COINCIDENTES SOBREESCRIBE.

Este debate contiene 10 respuestas, tiene 2 mensajes y lo actualizó  FSLALOP hace 5 meses .

Viendo 11 publicaciones - del 1 al 11 (de un total de 11)
  • Autor
    Publicaciones

  • FSLALOP
    Participant

    Hola buenas tardes escribo a este foro esperando poder contar con ayuda de su parte y agradeciendo de antemano igual el apoyo brindado.

    Actualmente estoy empezando en este mundo de las Macros, por lo que al ser nuevo me encuentro con muchas dudas a cerca de algunas que puedan facilitarme la vida y evitar lo rutinario.

    Estoy realizando un archivo que consta de 3 hojas.

    1. En la Hoja 1 , pego el reporte (Facturación) tal como lo traigo del sistema, contiene varias fechas el reporte.
    2. En la Hoja Dos coloque un Filtro avanzado por medio de un formulario VBA y filtro la fecha que requiero trabajar de ese reporte.
    3. los datos que trabajo en la Hoja 2 después de filtrada la fecha , es colocar en la ultima columna el Status de Esa factura (si esta en transito, en almacén, se le dejo al cliente, o esta pendiente).
    4. Después de que he colocado el Status la enviare a archivar a la Hoja 3 ya con el status Actualizado, pero es aqui donde requiero una macro que busque si esta factura ya estaba archivada (la linea completa que la valore) y si es que ya se había archivado con anterioridad con un Status de Pendiente que ahora me sobreecriba en esa linea el nuevo Status, para no generar lineas duplicadas de la misma FACTURA.

    Saludos y gracias.

    vichopalacios
    vichopalacios
    Moderator

    Hola FSLALOP
    Tu consulta representa un típico caso en que Excel nos ayuda en gran medida a realizar tareas repetitivas.
    Al no tener en mis manos tu libro, no me es posible darte una respuesta concreta, pero te daré algunos lineamientos generales.
    Supongo que luego de tus operaciones descritas hasta el paso 3 terminas con una tabla en que alguna de sus columas es el identificador de factura (número o código), en otra tienes la fecha, en otra tienes el status, y tienes algunas otras con info que por ahora no es interesante.
    Supongo también que en la Hoja3 de archivo tienes una tabla que, entre otras, tiene al menos las mismas 3 columnas que mencioné artiba.
    En tu Macro deberías encontrar primero la última fila usada en Hoja2 y en Hoja3.
    Luego debes generar 2 LOOPS anidados en que el primero recorras una por una las celdas en la columna NumeroFactura de Hoja2, y el segundo las compare una por una con cada celda de la misma columna de Hoja3
    Cuando se de la igualdad, realizas lo que necesites.
    Dame un tiempo para acercarme a un ordenador y te pondré tramos de código que te ayudarán en tu tarea

    Saludos


    FSLALOP
    Participant

    Hola Vicho gracias por la atención, actualmente el código que utilizo para archivar lo realice con la grabadora de macros y es un código sencillo:

    Sub Macro1()

    Application.ScreenUpdating = False

    Sheets(“Consulta”).Select
    Range(“A10”).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(“A10:K1000”).Select
    Selection.Copy

    Sheets(“Archivo”).Select

    Range(“A1”).Select
    Range(“A1”).End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range(“A1”).Select
    Sheets(“Consulta”).Select

    Range(“B3”).Select

    Application.ScreenUpdating = True

    Toma los datos de la Hoja de Consulta y los archiva en la hoja de Archivo, pero es aquí donde el código es simple y solo busca la siguiente celda vacía y genera un duplicado de las lineas de información.

    End Sub

    vichopalacios
    vichopalacios
    Moderator

    Las acciones de tu Macro, pulidas un poquito se podrían escribir así:

     Code: arbitrary (select
    1.
    2.
    3.
    4.
    5.
    6.
    7.
    8.
    9.
    10.
    11.
    12.
    13.
    14.
    15.
    16.
    17.
    18.
    19.
    20.
    21.
    22.

    Sub MacroMia()
    Dim ShtC As Worksheet
    Dim ShtA As Worksheet
    Dim UltFilaC As Long
    Dim UltFilaA As Long
    Dim UltColC As Integer

    Application.ScreenUpdating = False
    Set ShtC = Sheets("Consulta")
    Set ShtA = Sheets("Archivo")

    UltFilaC = ShtC.Cells(Rows.Count, "A").End(xlUp).Row
    UltFilaA = ShtA.Cells(Rows.Count, "A").End(xlUp).Row
    UltColC = ShtC.Cells(10, Columns.Count).End(xlToLeft).Column

    ShtC.Cells(10, 1).Resize(UltFilaC - 10, UltColC).Copy
    ShtA.Cells(UltFilaA + 1, 1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ShtA.Cells(1, 1).Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub

    Te recomiendo que evites a toda costa usar “Activate”, “Select”, a menos que realmente sea necesario.
    Para poder continuar se necesita conocer la estructura de tus datos, de modo que sepamos que columna recorrer en cada hoja.
    Si analizas el código propuesto podrás sacar algunas ideas que te ayuden.
    Saludos


    FSLALOP
    Participant

    https://drive.google.com/file/d/0B1ezaTQ3SkmtSVp3S0QzSE41b0k/view?usp=sharing

    Hola Vichopalacios, te anexo el Link para que puedas observar como esta estructurado el archivo, la macro que me enviaste se me hace realmente buena, la agregue al archivo y la ejecute, pero aun me sigue generando lineas adicionales debajo de la siguiente linea vacía.

    sin mas agradezco la atención que has prestado a mis inquietudes.

    saludos y gracias.

    vichopalacios
    vichopalacios
    Moderator

    Al revisar tu libro, y correr la macro que te propuse, no veo que se
    “”sigue generando lineas adicionales debajo de la siguiente linea vacía””
    Se han corregido un par de líneas, por pequeños errores:

    En esta línea he cambiado el “10” por un “9” en el argumento del resize:
    1.  ShtC.Cells(10, 1).Resize(UltFilaC - 9, UltColC).Copy

    y se ha aumentado ShtA.Activate antes de
    1.  "ShtC.Cells(1, 1).Select".

    Ahora, con respecto al proceso de archivar, viendo los datos en la pestaña Arhivo, no me queda muy claro cual es tu necesidad.:

    Comparar los diferentes registros ( Líneas), en la columna A “Movimiento” desde arriba hacia abajo, y cuando encuentre uno repetido se debe comparar la celda correspondiente a la columna “Status”.
    .- si son iguales se debe …???? (tal vez eliminar una de las dos filas)
    ( o no hacer nada y dejar como está, dejando lineas exactas repetidas)..???
    .- si el status es diferente se debe…? eliminar o no, la fila ( la nueva o la anterior)…? sobre-escribir el status …( en cual de las filas, …?.
    Las instrucciones deben ser absolutamente claras para codificarlas.

    Este sería el código preparado para ese efecto:

     Code: arbitrary (select
    1.
    2.
    3.
    4.
    5.
    6.
    7.
    8.
    9.
    10.
    11.
    12.
    13.
    14.
    15.
    16.
    17.
    18.
    19.
    20.
    21.
    22.
    23.
    24.
    25.
    26.
    27.
    28.
    29.
    30.
    31.
    32.
    33.
    34.
    35.
    36.
    37.
    38.
    39.
    40.
    41.
    42.
    43.
    44.

    Sub MacroMia()
    Dim ShtC As Worksheet, ShtA As Worksheet
    Dim UltFilaC As Long, UltFilaA As Long
    Dim UltColC As Integer
    Dim i As Long, j As Long

    Application.ScreenUpdating = False
    Set ShtC = Sheets("Consulta")
    Set ShtA = Sheets("Archivo")

    UltFilaC = ShtC.Cells(Rows.Count, "A").End(xlUp).Row
    UltFilaA = ShtA.Cells(Rows.Count, "A").End(xlUp).Row
    UltColC = ShtC.Cells(10, Columns.Count).End(xlToLeft).Column

    ShtC.Cells(10, 1).Resize(UltFilaC - 9, UltColC).Copy
    ShtA.Cells(UltFilaA + 1, 1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ShtA.Activate
    ShtA.Cells(1, 1).Select
    Application.CutCopyMode = False

    'Encontrar la nueva última fila, luego de haber copiado la consulta.
    UltFilaA = ShtA.Cells(Rows.Count, "A").End(xlUp).Row
    'Recorrer una por una las celdas de la columna A
    For i = 2 To UltFilaA
        'Recorrer las celdas hacia abajo de la actual para comparar
        For j = i + 1 To UltFilaA
            'Comparar la columna A
            If ShtA.Cells(i, 1).Value = ShtA.Cells(j, 1).Value Then
                'Comparar la columna K
                If ShtA.Cells(i, 11).Value = ShtA.Cells(j, 11).Value Then
                    'colocar aquí
                    'Código en caso de igualdad
                    ShtA.Cells(j, 12).Value = "Misma factura e igual status a fila " & i
                Else
                    'colocar aquí
                    'Código en caso de desigualdad
                    ShtA.Cells(j, 12).Value = "Misma factura y diferente status a fila " & i
                End If
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
    End Sub

    Saludos


    FSLALOP
    Participant

    Hola Vichopalacios, nuevamente agradeciendote que sigas atendiendome.

    Revise nuevamente la Macro que me has enviado y adapté para correrla, funciona bien.

    Las preguntas que me haces son:
    Si al comparar los diferentes registros ( Líneas), en la columna A “Movimiento” desde arriba hacia abajo, y cuando encuentre uno repetido se debe comparar la celda correspondiente a la columna “Status”.
    .- si son iguales se debe …???? (tal vez eliminar una de las dos filas). Mi respuesta es ; Si son iguales eliminar una de las dos Filas.

    si el status es diferente se debe…? eliminar o no, la fila ( la nueva o la anterior)…? sobre-escribir el status …( en cual de las filas, …?. Mi respuesta es ; eliminar la fila anterior y dejar la nueva que a consideración es la que tendrá el nuevo status.

    Sin mas agradezco tu atención y nuevamente agradezco la super ayuda que me estas proporcionando.

    vichopalacios
    vichopalacios
    Moderator

    Hola FSLALOP

    Entonces, para quedar claros, el código debería analizar solamente la columna de “Movimiento”, y eliminar las lineas repetidas que se encuentren más arriba y dejar como única la que esté más abajo…?

    Por lo tanto la tabla mostraría un listado de registros en que el número de factura es único.


    FSLALOP
    Participant

    Hola buen día Vichopalacios es correcto lo que me comentas.

    El código debe analizar la columna de movimiento y antes de archivar de nuevo una linea analizar la columna de movimiento y si ya existe una linea similar, eliminar la anterior y dejar únicamente una linea ( la actual que se esta archivando, puesto que esta tendrá de igual manera actualizado el Status).

    Mostrando el formato como me dices un numero de factura Único.

    Agradezco nuevamente tu atención.

    Saludos cordiales.

    vichopalacios
    vichopalacios
    Moderator

    Este macro que te presento, no es el método más eficiente, pero tómalo como una lección de aprendizaje de codificación VBA.

     Code: arbitrary (select
    1.
    2.
    3.
    4.
    5.
    6.
    7.
    8.
    9.
    10.
    11.
    12.
    13.
    14.
    15.
    16.
    17.
    18.
    19.
    20.
    21.
    22.
    23.
    24.
    25.
    26.
    27.
    28.
    29.
    30.
    31.
    32.
    33.
    34.
    35.
    36.
    37.
    38.
    39.
    40.
    41.
    42.
    43.
    44.
    45.
    46.
    47.
    48.

    Sub MacroMia()
    Dim ShtC As Worksheet, ShtA As Worksheet
    Dim UltFilaC As Long, UltFilaA As Long
    Dim UltColC As Integer, Borra As Integer
    Dim i As Long, j As Long

    Application.ScreenUpdating = False
    Set ShtC = Sheets("Consulta")
    Set ShtA = Sheets("Archivo")

    UltFilaC = ShtC.Cells(Rows.Count, "A").End(xlUp).Row
    UltFilaA = ShtA.Cells(Rows.Count, "A").End(xlUp).Row
    UltColC = ShtC.Cells(10, Columns.Count).End(xlToLeft).Column

    ShtC.Cells(10, 1).Resize(UltFilaC - 9, UltColC).Copy
    ShtA.Cells(UltFilaA + 1, 1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ShtA.Activate
    ShtA.Cells(1, 1).Select
    Application.CutCopyMode = False

    'Encontrar la nueva última fila, luego de haber copiado la consulta.
    UltFilaA = ShtA.Cells(Rows.Count, "A").End(xlUp).Row
    'Recorrer una por una las celdas de la columna A
    For i = 2 To UltFilaA
        'Recorrer las celdas hacia abajo de la actual para comparar
        For j = i + 1 To UltFilaA
            'Comparar la columna A
            If ShtA.Cells(i, 1).Value = ShtA.Cells(j, 1).Value Then
               ShtA.Cells(i, 12).Value = "Borrar, repetido en línea " & j
               Exit For
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
    Borra = MsgBox("Desea eliminar las filas?", vbYesNo + vbQuestion, "Se eliminarán las filas Duplicadas")
    Application.ScreenUpdating = False
    If Borra = vbYes Then
        For i = UltFilaA To 1 Step -1
            If ShtA.Cells(i, 12).Value Like "Borrar,*" Then
                ShtA.Cells(i, 1).EntireRow.Delete
            End If
        Next i
    Else
        ShtA.Range("L:L").ClearContents
    End If
    Application.ScreenUpdating = True
    End Sub


    FSLALOP
    Participant

    Hola Vichopalacios no me había conectado, pero es grato encontrar una respuesta a mis inquietudes, ya probé el código que me enviaste y en realidad esta muy bien, queda resuelta mi peticion, agradezco el apoyo.

    Saludos cordiales.

Viendo 11 publicaciones - del 1 al 11 (de un total de 11)

Debes estar registrado para responder a este debate.