Contar datos de una base de datos en excel
Tengo una macro que me cuenta los registros en una base de datos en excel, pero siempre que la aplico me repite los datos que ya se habían contado, alguien puede darme alguna idea de como solucionar esto. Esta es la macro. Es perfecta y fue construida por James Bond, pero me repite los datos que ya existen. Esta base de datos se actualiza diariamente y lo que necesito es que siempre que la corra, me agregue los valores nuevos después de los existentes pero solo cuente los nuevos registros ingresados.
Gracias a todos, SON UNOS genios!
Sub contar_maletas_diarias()
Set h1 = Worksheets("Database")
Set h2 = Worksheets("discrepance")
With h1.Range("a2").CurrentRegion
f = .Rows.Count - 1: c = .Columns.Count - 3
End With
Set datos = h1.Range("a2").Resize(f, c)
Set destino = h2.Range("a1").CurrentRegion
f = datos.Rows.Count: c = datos.Columns.Count
With destino
fd = .Rows.Count: CD = .Columns.Count
Set destino = .Rows(fd + 1).Resize(f, CD)
Datos. Columns(1).Copy: .Cells(1, 1). PasteSpecial
datos. Columns(3).Copy: .Cells(1, 2). PasteSpecial
datos. Columns(4). Resize(datos. Rows. Count, 2).Copy: .Columns(4).Resize(fd, 2). PasteSpecial
.RemoveDuplicates Columns:=Array(1, 2, 4, 5)
CUENTAB = WorksheetFunction.CountA(.Columns(1))
For I = 1 To CUENTAB
FECHA = .Cells(I, 1)
VUELO = .Cells(I, 2)
DEST = .Cells(I, 4)
TIPO = destino.Cells(I, 5)
AIRLINE = destino.Cells(I, 6)
CUENTA = WorksheetFunction.CountIfs(datos.Columns(1), FECHA, datos.Columns(3), VUELO, _
datos.Columns(4), DEST, datos.Columns(5), TIPO)
.Cells(I, 3) = CUENTA
Next I
CELDA1 = .Cells(1, 3).Address(False, False)
CELDA2 = .Cells(1, 6).Address(False, False)
.Cells(1, 7).Resize(CUENTAB, 1).Formula = "=IF(" & CELDA1 & "=" & CELDA2 & "," & """MATCH""" & "," & """NO MATCH""" & ")"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = xlNone
End With
Set datos = Nothing: Set destino = Nothing
End Sub
1 Respuesta
Solo hay una solución y es la siguiente, trabajando sobre el archivo que me enviaste previamente y suponiendo que este no halla cambiado, al lado la macro después de procesar la información coloca la leyenda contado a cada registro contabilizado así en la siguiente vez que corras las macro estos registros serán descartados y so se enfocara en procesar los vuelos que no tienen esta leyenda
la macro modificada es esta, hay un detalle que no me había percatado y es que tienes una celda combinada en la celda A1:A4 esto afecta el funcionamiento de la macro que tienes en esta modificación ya hice el ajuste para que no afecte el funcionamiento de la macro.
Sub contar_maletas_diarias()
Set h1 = Worksheets("bingosheet")
Set h2 = Worksheets("discrepance")
With h1.Range("a5").CurrentRegion
F = .Rows.Count - 1: C = .Columns.Count - 3
End With
Set DATOS = h1.Range("a6").Resize(F, C)
CUENTA = WorksheetFunction.CountIf(DATOS.Columns(C + 1), "CONTADO")
If CUENTA = F - 4 Then
GoTo SALIR
Else
Set DATOS = DATOS.Rows(CUENTA + 1).Resize(F - CUENTA - 4, C)
End If
Set destino = h2.Range("a1").CurrentRegion
F = DATOS.Rows.Count: C = DATOS.Columns.Count
With destino
fd = .Rows.Count: CD = .Columns.Count
Set destino = .Rows(fd + 1).Resize(F, CD)
DATOS.Columns(1).Copy: .Cells(1, 1).PasteSpecial
DATOS.Columns(3).Copy: .Cells(1, 2).PasteSpecial
DATOS.Columns(4).Resize(DATOS.Rows.Count, 2).Copy: .Columns(4).Resize(fd, 2).PasteSpecial
DATOS.Columns(C + 1) = "CONTADO"
.RemoveDuplicates Columns:=Array(1, 2, 4, 5)
CUENTAB = WorksheetFunction.CountA(.Columns(1))
For I = 1 To CUENTAB
FECHA = .Cells(I, 1)
VUELO = .Cells(I, 2)
DEST = .Cells(I, 4)
TIPO = destino.Cells(I, 5)
CUENTA = WorksheetFunction.CountIfs(DATOS.Columns(1), FECHA, DATOS.Columns(3), VUELO, _
DATOS.Columns(4), DEST, DATOS.Columns(5), TIPO)
.Cells(I, 3) = CUENTA
Next I
CELDA1 = .Cells(1, 3).Address(False, False)
CELDA2 = .Cells(1, 6).Address(False, False)
.Cells(1, 7).Resize(CUENTAB, 1).Formula = "=IF(" & CELDA1 & "=" & CELDA2 & "," & """MATCH""" & "," & """NO MATCH""" & ")"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = xlNone
End With
Set DATOS = Nothing: Set destino = Nothing
SALIR:
End Sub
