Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Comparar dos tablas en la misma hoja BVA Macro

Excel - Comparar dos tablas en la misma hoja BVA Macro

Volver
Nuevo Tema
<<>>
 
Vista:

Comparar dos tablas en la misma hoja BVA Macro

Publicado por Andres (1 intervención) el 09/12/2021 11:32:20
Hola!

Tengo un Codigo que me compara dos tablas estandarizadas en dos hojas distintas y me marca los valores modificados en amarillo y los valores nuevos en rojo.


Me gustaria saber si puedo hacer lo mismo pero con las tablas en la misma hoja. como podria modificar los rangos?

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
Sub Compara_Hoja1()
'Declaramos variables
Dim scadena As String, scadena_2 As String
Dim i As Long, j As Long, n As Long
Dim col As Long, fin As Long, final As Long, d As Long
Dim a As Long, x As Long, p As Long, col_1 As Long, col_2 As Long
'Trabajamos con la Hoja 1 TEST
With Sheets("test")
fin = Application.CountA(.Range("A:A"))
final = Application.CountA(Sheets("test 2").Range("A:A"))
col_1 = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
col_2 = Sheets("test 2").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
'Iniciamos primer loop recorriendo registros hoja1
For i = 2 To fin
'Componemos cadena con toda la fila hoja1 TEST
For d = 1 To col_1
scadena = scadena & .Cells(i, d).Value
Next d
'Iniciamos segundo loop buscando valor de scadena de hoja1 en hoja2
For j = 2 To final
'Componemos cadena de toda la fija hoja2 Test 2
For a = 1 To col_2
scadena_2 = scadena_2 & Sheets("test 2").Cells(j, a).Value
Next a
'Si el ID existe en la hoja2 contamos
If .Cells(i, 1) = Sheets("test 2").Cells(j, 1) Then p = p + 1
'Si el ID es igual al de la hoja2 pero la cadena no es igual iniciamos un tercer loop
If .Cells(i, 1) = Sheets("test 2").Cells(j, 1) And scadena <> scadena_2 Then
'Recorremos toda la fila hasta encontrar la diferencia y la marcamos en rojo
For n = 1 To col_2
If .Cells(i, n) <> Sheets("test 2").Cells(j, n) Then .Cells(i, n).Interior.Color = vbYellow
Next n
End If
'vaciamos valor de variable scadena_2
scadena_2 = vbNullString
Next j
'Si el ID no existe en hoja2 recorremos cadena y marcamos diferencias
If p = 0 Then
For x = 1 To col_2
If .Cells(i, x) <> Sheets("test 2").Cells(j, x) Then .Cells(i, x).Interior.Color = vbRed
Next x
End If
p = 0
scadena = vbNullString
Next i
End With
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Comparar dos tablas en la misma hoja BVA Macro

Publicado por Antoni Masana (2474 intervenciones) el 09/12/2021 14:40:51
Una cosa que ayuda un montón es empezar por escribir bien el código para que los mortales lo podamos leer, al Excel le da lo mismo.

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
Sub Compara_Hoja1()
    ' ---&---  Declaramos variables
    Dim scadena As String, scadena_2 As String
    Dim i As Long, j As Long, n As Long
    Dim col As Long, fin As Long, final As Long, d As Long
    Dim a As Long, x As Long, p As Long, col_1 As Long, col_2 As Long
    ' ---&---  Trabajamos con la Hoja 1 TEST
    With Sheets("test")
        fin = Application.CountA(.Range("A:A"))
        final = Application.CountA(Sheets("test 2").Range("A:A"))
        col_1 = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
        col_2 = Sheets("test 2").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
        ' ---&---  Iniciamos primer loop recorriendo registros hoja1
        For i = 2 To fin
            ' ---&---  Componemos cadena con toda la fila hoja1 TEST
            For d = 1 To col_1
                scadena = scadena & .Cells(i, d).Value
            Next d
            ' ---&---  Iniciamos segundo loop buscando valor de scadena de hoja1 en hoja2
            For j = 2 To final
                ' ---&---  Componemos cadena de toda la fija hoja2 Test 2
                For a = 1 To col_2
                    scadena_2 = scadena_2 & Sheets("test 2").Cells(j, a).Value
                Next a
                ' ---&---  Si el ID existe en la hoja2 contamos
                If .Cells(i, 1) = Sheets("test 2").Cells(j, 1) Then p = p + 1
                ' ---&---  Si el ID es igual al de la hoja2 pero la cadena no es igual iniciamos un tercer loop
                If .Cells(i, 1) = Sheets("test 2").Cells(j, 1) And scadena <> scadena_2 Then
                    ' ---&---  Recorremos toda la fila hasta encontrar la diferencia y la marcamos en rojo
                    For n = 1 To col_2
                        If .Cells(i, n) <> Sheets("test 2").Cells(j, n) Then .Cells(i, n).Interior.Color = vbYellow
                    Next n
                End If
                ' ---&---  vaciamos valor de variable scadena_2
                scadena_2 = vbNullString
            Next j
            ' ---&---  Si el ID no existe en hoja2 recorremos cadena y marcamos diferencias
            If p = 0 Then
                For x = 1 To col_2
                    If .Cells(i, x) <> Sheets("test 2").Cells(j, x) Then .Cells(i, x).Interior.Color = vbRed
                Next x
            End If
            p = 0
            scadena = vbNullString
        Next i
    End With
End Sub

Lo segundo es ponerte en la hoja que tienes las tablas antes de empezar, es decir después del DIM y quitar todos los demás Sheets()
Lo tercero poner esto para que la macro sea más efectiva:

Application.screenupdating=False
Application.calculation=xlCalculationManual
Application.EnableEvents=False
ActiveSheet.DisplayPageBreaks = False

Lo cuarto: una tabla debe empezar en la columna A y la otro en la columna X ( la que sea) pues cambia dicha columna cuando trates la segunda tabla.

Y quinto y último esto para finalizar:

Application.screenupdating=True
Application.calculation=xlCalculationAutomatic
Application.EnableEvents=True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False

Esto o subir el libro.

Saludos
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar