Contar datos de una base de datos

Estoy trabajando una aplicación en laque dirariamente se registran datos de diferentes vuelos que entran y salen. Muchos de ellos son identificados con el mismo numero aunque el destino es diferente. Desde este sitio mis amigos Seba y James me ayudaron con el código de la macro, pero necesito que al momento de hacer el conteo me identifique también el destino y el tipo de vuelo. Voy a poner una captura de pantalla de la base de datos y de la hoja donde se registra el conteo, así como el código en vba para ver si me pueden ayudar a mejorarlo

Este es un ejemplo de los datos capturados para un vuelo con el mismo numero y diferentes destinos y tipos

Y Esta es la hoja donde necesito diariamente actualizar el conteo manteniendo los datos ya colectados anteriormente

Gracias, aprecio la ayuda que siempre recibo desde este foro

La idea es que me cuente los nuevos registros insertados y me los vaya agregando al final de la fila con datos y me incorpore la información del destino y el tipo de vuelo

Este es el codigo

Sub contar_maletas_diarias()
Dim funcion As WorksheetFunction
Set h2 = Worksheets("discrepance")
Set datos = Range("Alldata").CurrentRegion
Set destino = h2.Range("A2").CurrentRegion
Set funcion = WorksheetFunction
With datos
f = .Rows.Count: C = .Columns.Count
Set datos = .Rows(2).Resize(f - 1, C)
With destino
fd = .Rows.Count: cd = .Columns.Count
If fd > 1 Then
Set destino = .Rows(fd + 1).Resize(f - 1, 3)
Else
Set destino = .Resize(f - 1, 2)
End If
Union(datos.Columns(1), datos.Columns(3), datos.Columns(4)).Copy: destino.PasteSpecial
.RemoveDuplicates Columns:=Array(1, 2)
blancos = funcion.CountBlank(destino.Columns(1))
If blancos > 0 Then Set destino = .Resize(.Rows.Count - blancos)
For i = 1 To destino.Rows.Count
Fecha = .Cells(i, 1)
Vuelo = .Cells(i, 2)
cuenta = funcion.CountIfs(datos.Columns(1), Fecha, datos.Columns(3), Vuelo)
.Cells(i, 3) = cuenta
Next i
End With
Set datos = Nothing: Set destino = Nothing: Set h2 = Nothing: Set funcion = Nothing
End With
End Sub

1 respuesta

Respuesta
1

¿Puedes poner un ejemplo del resultado que esperas?, no me queda claro cual o como es el resultado final

Con gusto, el código anterior me lo preparaste tu, no se si recuerdas, pero voy a poner en la base de datos resultados ficticios para que tengas una idea de como lo necesito, importante para mi que funcione en 32 bits y que copie la información a partir de la fila 2, no de la 3. El código solo colectaría las columnas de la 1 a la 5 yo pongo manualmente los datos de la columna 6 por ahora y si me puedes ayudar con el código para la columna 7 seria genial. Si todavía no te queda claro, solo dejame saber, aprecio mucho tu ayuda e inteligencia

Gracias James.

Esto es lo que entiendo que quieres, la macro cuenta por fecha, vuelo, destino y in/out al mismo tiempo coloca la fórmula en status y por cierto todas las macros que hago estan hechas en 32 bits ya que esa es la plataforma que tiene mi computadora

y esta es la macro 

Sub contar_maletas_diarias()
Set h2 = Worksheets("discrepance")
Set datos = Range("alldata")
Set destino = h2.Range("a2").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)
        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""" & ")"
    .Interior.ColorIndex = xlNone
End With
Set datos = Nothing: Set destino = Nothing
End Sub

Gracias james, eres un genio, pero cuándo corro la macro me da un error en esta línea:

Set destino = .Rows(fd + 1).Resize(F, CD)

Gracias

¿Puedes poner que tipo de error te da?, en mi macro no muestra ese error, la única forma en que te de error en esa línea es cuando f o C sean igual a 0 y eso lo puedes ve en el panel locales o lo que es lo mismo no tienes datos que copiar, sube una imagen como la que te muestro, activa el panel de locales, luego corre la macro y después que ocurra el error fíjate en los valores C y F además te falta indicar que numero de error tienes.

Si tiene datos, esta la captura del po pup de error

Entonces la única seria que subieras el rchivo que te da error a la nube para descargarlo y ver que esta pasando con el, yo la he tratado de reproducir el error y solo lo consigo cuando f o c son iguales a 0

Tienes algun email para enviartelo mas tarde?

Te paso el enlace para que descargues el archivo ejemplo

https://1drv.ms/x/s!Aqt18sdMf2xXiR6QMYIrve7mbGMM 

Aquí te comparto el archivo para que lo revises, te estoy muy pero muy agradecido

https://drive.google.com/file/d/16qV4gW7FHz1FTkkDUQz8LPcWvzM-0W8N/view?usp=sharing 

Si había un error y esta en lo siguiente yo mandaba llamar a los datos a filtrar usando un tabla llamada alldata, que en tu caso no existe y por esta razón te daba error no porque no existiera la información sino que al total de las filas de excel 1 millón y algo le sumaba una fila más lo cual quedaba fuera del rango de la hoja también esta el detalle que tienes un formato diferente al que yo use en la primera version esas filas en amarillo también las incluía

como ves en esta imagen la macro funciona después de haberla modificado por cierto tienes un programa en el thisworkbook que también da problemas a la hora de correr la macro así que la tuve que eliminar, te recomiendo hagas lo mismo

y esta es la macro modificada, ya no debe de dar problemas

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)
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)
        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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas